├── .gitignore ├── lib ├── fib.joy ├── mandel.joy ├── test.joy ├── gcd.joy ├── alljoy.joy ├── quad.joy ├── tutinp.joy ├── prelib.joy ├── joytut.com └── jp-joytst.joy ├── doc └── Wynn.PNG ├── test1 ├── empty.joy ├── exist.joy ├── minim.joy ├── incl.joy ├── main5.joy ├── const.joy ├── quad.joy ├── m26.joy ├── m23.joy ├── m22.joy ├── m25.joy └── m24.joy ├── test2 ├── id.joy ├── _help.joy ├── abort.joy ├── argc.joy ├── clock.joy ├── echo.joy ├── help.joy ├── quit.joy ├── time.joy ├── true.joy ├── ceil.joy ├── manual.joy ├── ord.joy ├── pop.joy ├── popd.joy ├── putch.joy ├── stdin.joy ├── __dump.joy ├── autoput.joy ├── conts.joy ├── false.joy ├── fold.joy ├── over.joy ├── setsize.joy ├── dup.joy ├── gmtime.joy ├── __symtabmax.joy ├── abs.joy ├── chr.joy ├── div.joy ├── dupd.joy ├── fflush.joy ├── get.joy ├── leaf.joy ├── modf.joy ├── pred.joy ├── stack.joy ├── stderr.joy ├── stdout.joy ├── strtod.joy ├── succ.joy ├── swap.joy ├── __html_manual.joy ├── __manual_list.joy ├── __symtabindex.joy ├── app1.joy ├── app11.joy ├── app2.joy ├── assign.joy ├── fclose.joy ├── feof.joy ├── file.joy ├── float.joy ├── list.joy ├── localtime.joy ├── set.joy ├── srand.joy ├── swapd.joy ├── __latex_manual.joy ├── app3.joy ├── body.joy ├── cos.joy ├── exp.joy ├── fgetch.joy ├── floor.joy ├── format.joy ├── log.joy ├── rand.joy ├── rollup.joy ├── rotate.joy ├── sin.joy ├── tan.joy ├── trunc.joy ├── while.joy ├── app4.joy ├── cosh.joy ├── ferror.joy ├── getenv.joy ├── integer.joy ├── nullary.joy ├── pick.joy ├── pow.joy ├── rolldown.joy ├── rollupd.joy ├── rotated.joy ├── sinh.joy ├── sqrt.joy ├── string.joy ├── tanh.joy ├── unary2.joy ├── unary3.joy ├── app12.joy ├── atan2.joy ├── char.joy ├── i.joy ├── log10.joy ├── unary4.joy ├── undeferror.joy ├── user.joy ├── __memorymax.joy ├── __settracegc.joy ├── binrec.joy ├── fremove.joy ├── ftell.joy ├── linrec.joy ├── rolldownd.joy ├── setundeferror.joy ├── __memoryindex.joy ├── at.joy ├── of.joy ├── unstack.joy ├── choice.joy ├── fopen.joy ├── logical.joy ├── fseek.joy ├── ifte.joy ├── round.joy ├── branch.joy ├── fread.joy ├── frename.joy ├── argv.joy ├── frexp.joy ├── neg.joy ├── cons.joy ├── fwrite.joy ├── filetime.joy ├── fput.joy ├── fputch.joy ├── fputchars.joy ├── fputstring.joy ├── gc.joy ├── rem.joy ├── swons.joy ├── system.joy ├── cleave.joy ├── genrec.joy ├── ifset.joy ├── mul.joy ├── plus.joy ├── tailrec.joy ├── undefs.joy ├── x.joy ├── atan.joy ├── dip.joy ├── ifchar.joy ├── iffile.joy ├── minus.joy ├── mktime.joy ├── unary.joy ├── iflist.joy ├── setecho.joy ├── binary.joy ├── iffloat.joy ├── intern.joy ├── first.joy ├── rest.joy ├── treestep.joy ├── ifinteger.joy ├── iflogical.joy ├── ternary.joy ├── construct.joy ├── divide.joy ├── setautoput.joy ├── sign.joy ├── in.joy ├── treerec.joy ├── has.joy ├── enconcat.joy ├── ldexp.joy ├── or.joy ├── strtol.joy ├── times.joy ├── unassign.joy ├── asin.joy ├── helpdetail.joy ├── size.joy ├── acos.joy ├── and.joy ├── include.joy ├── xor.joy ├── ifstring.joy ├── put.joy ├── uncons.joy ├── condnestrec.joy ├── treegenrec.joy ├── case.joy ├── finclude.joy ├── max.joy ├── min.joy ├── condlinrec.joy ├── primrec.joy ├── unswons.joy ├── drop.joy ├── infra.joy ├── maxint.joy ├── typeof.joy ├── casting.joy ├── neql.joy ├── geql.joy ├── greater.joy ├── name.joy ├── step.joy ├── all2.joy ├── leql.joy ├── map.joy ├── less.joy ├── sametype.joy ├── concat.joy ├── small.joy ├── cond.joy ├── filter.joy ├── some.joy ├── take.joy ├── not.joy ├── opcase.joy ├── putchars.joy ├── split.joy ├── formatf.joy └── null.joy ├── src ├── gc.c ├── quit.c ├── app2.c ├── pop.c ├── app3.c ├── app4.c ├── id.c ├── get.c ├── app11.c ├── abort.c ├── i.c ├── manual.c ├── fputstring.c ├── true.c ├── false.c ├── dup.c ├── echo.c ├── rand.c ├── x.c ├── __dump.c ├── jump.c ├── stdin.c ├── app1.c ├── stderr.c ├── fclose.c ├── srand.c ├── stdout.c ├── treerec.c ├── putch.c ├── __html_manual.c ├── stack.c ├── time.c ├── conts.c ├── fflush.c ├── putchars.c ├── argc.c ├── autoput.c ├── fold.c ├── popd.c ├── unstack.c ├── maxint.c ├── set.c ├── undeferror.c ├── app12.c ├── ord.c ├── __symtabmax.c ├── chr.c ├── list.c ├── __memoryindex.c ├── __symtabindex.c ├── char.c ├── dip.c ├── leaf.c ├── over.c ├── __latex_manual.c ├── file.c ├── float.c ├── enconcat.c ├── string.c ├── __memorymax.c ├── cos.c ├── feof.c ├── integer.c ├── logical.c ├── sin.c ├── strtod.c ├── tan.c ├── clock.c ├── ferror.c ├── ftell.c ├── trunc.c ├── acos.c ├── asin.c ├── fputch.c ├── genrec.c ├── log.c ├── setecho.c ├── spush.c ├── times.c ├── atan.c ├── ceil.c ├── fgetch.c ├── floor.c ├── sinh.c ├── sqrt.c ├── swap.c ├── cosh.c ├── tanh.c ├── log10.c ├── exp.c ├── round.c ├── setsize.c ├── treegenrec.c ├── __settracegc.c ├── getenv.c ├── neg.c ├── user.c ├── dupd.c ├── casting.c ├── setautoput.c ├── body.c ├── include.c ├── put.c ├── setundeferror.c ├── system.c ├── choice.c ├── ifset.c ├── cpush.c ├── branch.c ├── iflist.c ├── typeof.c ├── ifchar.c ├── iffloat.c ├── iffile.c ├── ldexp.c ├── rotate.c ├── fremove.c ├── ifstring.c ├── pfalse.c ├── strue.c ├── rollup.c ├── swapd.c ├── ifinteger.c ├── abs.c ├── fjump.c ├── fputchars.c ├── jfalse.c ├── rolldown.c ├── iflogical.c ├── argv.c ├── fput.c ├── mktime.c ├── pow.c ├── cswap.c ├── frename.c ├── atan2.c ├── pick.c ├── sign.c ├── eql.c ├── compare.c ├── fopen.c ├── neql.c ├── not.c ├── sametype.c ├── modf.c ├── strtol.c ├── rollupd.c ├── rotated.c ├── rolldownd.c ├── intern.c ├── div.c ├── frexp.c ├── fseek.c ├── nullary.c ├── binary.c ├── undefs.c ├── and.c ├── name.c ├── or.c ├── fwrite.c ├── condlinrec.c ├── finclude.c ├── strftime.c ├── _help.c ├── leql.c ├── geql.c ├── unary.c ├── xor.c ├── ternary.c ├── fgets.c ├── less.c ├── greater.c ├── size.c ├── filetime.c ├── first.c ├── decode.h ├── succ.c ├── unassign.c ├── help.c ├── pred.c ├── fread.c ├── case.c ├── treestep.c ├── rest.c ├── __manual_list.c ├── assign.c ├── cons.c ├── infra.c └── opcase.c ├── exec.c ├── print.c ├── xerr.c ├── prim.sh └── makefile /.gitignore: -------------------------------------------------------------------------------- 1 | *.tar 2 | -------------------------------------------------------------------------------- /lib/fib.joy: -------------------------------------------------------------------------------- 1 | 14 [small] [] [pred dup pred] [+] binrec. 2 | -------------------------------------------------------------------------------- /doc/Wynn.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Wodan58/Moy/HEAD/doc/Wynn.PNG -------------------------------------------------------------------------------- /lib/mandel.joy: -------------------------------------------------------------------------------- 1 | 2 | "fraclib.joy" include. 3 | 4 | 0 __settracegc. 5 | 6 | mandel pop. 7 | -------------------------------------------------------------------------------- /test1/empty.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : empty.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | -------------------------------------------------------------------------------- /test1/exist.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : exist.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | -------------------------------------------------------------------------------- /test1/minim.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : minim.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | -------------------------------------------------------------------------------- /test2/id.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : id.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | id. 7 | -------------------------------------------------------------------------------- /lib/test.joy: -------------------------------------------------------------------------------- 1 | "numlib" libload. 2 | 3 | 1001.1 cube-root. 4 | 5 | argc. 6 | 7 | argv. 8 | 9 | quit. 10 | -------------------------------------------------------------------------------- /test2/_help.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : _help.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | _help. 7 | -------------------------------------------------------------------------------- /test2/abort.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : abort.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | abort. 7 | -------------------------------------------------------------------------------- /test2/argc.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : argc.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | argc 1 =. 7 | -------------------------------------------------------------------------------- /test2/clock.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : clock.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | clock. 7 | -------------------------------------------------------------------------------- /test2/echo.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : echo.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | echo 0 =. 7 | -------------------------------------------------------------------------------- /test2/help.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : help.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | help. 7 | -------------------------------------------------------------------------------- /test2/quit.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : quit.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | quit. 7 | -------------------------------------------------------------------------------- /test2/time.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : time.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | time. 7 | -------------------------------------------------------------------------------- /test2/true.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : true.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [true] i. 7 | -------------------------------------------------------------------------------- /test2/ceil.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ceil.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 ceil 2 =. 7 | -------------------------------------------------------------------------------- /test2/manual.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : manual.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | manual. 7 | -------------------------------------------------------------------------------- /test2/ord.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ord.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 'A ord 65 =. 7 | -------------------------------------------------------------------------------- /test2/pop.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : pop.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 pop 1 =. 7 | -------------------------------------------------------------------------------- /test2/popd.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : popd.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 popd 2 =. 7 | -------------------------------------------------------------------------------- /test2/putch.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : putch.joy 3 | version : 1.5 4 | date : 04/15/24 5 | *) 6 | 'A putch. 7 | -------------------------------------------------------------------------------- /test2/stdin.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : stdin.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | stdin file. 7 | -------------------------------------------------------------------------------- /test1/incl.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : incl.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | "incl.joy" include. 7 | -------------------------------------------------------------------------------- /test2/__dump.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __dump.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | __dump 0 =. 7 | -------------------------------------------------------------------------------- /test2/autoput.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : autoput.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | autoput 1 =. 7 | -------------------------------------------------------------------------------- /test2/conts.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : conts.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | conts dup equal. 7 | -------------------------------------------------------------------------------- /test2/false.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : false.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [false] i not. 7 | -------------------------------------------------------------------------------- /test2/fold.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fold.joy 3 | version : 1.6 4 | date : 04/15/24 5 | *) 6 | [1 2 3] sum 6 =. 7 | -------------------------------------------------------------------------------- /test2/over.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : over.joy 3 | version : 1.3 4 | date : 03/21/24 5 | *) 6 | 1 2 3 over 2 =. 7 | -------------------------------------------------------------------------------- /test2/setsize.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : setsize.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | setsize 64 =. 7 | -------------------------------------------------------------------------------- /test2/dup.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : dup.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 dup stack [2 2] equal. 7 | -------------------------------------------------------------------------------- /test2/gmtime.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : gmtime.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | time gmtime 6 take. 7 | -------------------------------------------------------------------------------- /test1/main5.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : main5.joy 3 | version : 1.1 4 | date : 08/29/24 5 | *) 6 | 2 setautoput. 7 | 8 | 2 3. 9 | -------------------------------------------------------------------------------- /test2/__symtabmax.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __symtabmax.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | __symtabmax. 7 | -------------------------------------------------------------------------------- /test2/abs.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : abs.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | -1 abs 1 =. 7 | -1.1 abs 1.1 =. 8 | -------------------------------------------------------------------------------- /test2/chr.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : chr.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 10 chr '\n =. 7 | 65 chr 'A =. 8 | -------------------------------------------------------------------------------- /test2/div.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : div.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 54 24 div stack [6 2] equal. 7 | -------------------------------------------------------------------------------- /test2/dupd.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : dupd.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 dupd stack [3 2 2] equal. 7 | -------------------------------------------------------------------------------- /test2/fflush.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fflush.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | stdout fflush stdout =. 7 | -------------------------------------------------------------------------------- /test2/get.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : get.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | get get + 579 =. 7 | 123 456 8 | -------------------------------------------------------------------------------- /test2/leaf.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : leaf.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [] leaf false =. 7 | 'A leaf. 8 | -------------------------------------------------------------------------------- /test2/modf.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : modf.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 modf stack [1 0.5] equal. 7 | -------------------------------------------------------------------------------- /test2/pred.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : pred.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 'A pred '@ =. 7 | 1 pred 0 =. 8 | -------------------------------------------------------------------------------- /test2/stack.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : stack.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 stack [3 2 1] equal. 7 | -------------------------------------------------------------------------------- /test2/stderr.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : stderr.joy 3 | version : 1.5 4 | date : 04/15/24 5 | *) 6 | stderr dup putln file. 7 | -------------------------------------------------------------------------------- /test2/stdout.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : stdout.joy 3 | version : 1.5 4 | date : 04/15/24 5 | *) 6 | stdout dup putln file. 7 | -------------------------------------------------------------------------------- /test2/strtod.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : strtod.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "3.14" strtod 3.14 =. 7 | -------------------------------------------------------------------------------- /test2/succ.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : succ.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 'A succ 'B =. 7 | 2 succ 3 =. 8 | -------------------------------------------------------------------------------- /test2/swap.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : swap.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 swap stack [1 2] equal. 7 | -------------------------------------------------------------------------------- /test2/__html_manual.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __html_manual.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | __html_manual. 7 | -------------------------------------------------------------------------------- /test2/__manual_list.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __manual_list.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | __manual_list. 7 | -------------------------------------------------------------------------------- /test2/__symtabindex.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __symtabindex.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | __symtabindex. 7 | -------------------------------------------------------------------------------- /test2/app1.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : app1.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 [+] app1 stack [5 1] equal. 7 | -------------------------------------------------------------------------------- /test2/app11.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : app11.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 1 2 3 [+] app11 stack [5] equal. 7 | -------------------------------------------------------------------------------- /test2/app2.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : app2.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 [succ] app2 stack [4 3] equal. 7 | -------------------------------------------------------------------------------- /test2/assign.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : assign.joy 3 | version : 1.1 4 | date : 06/21/24 5 | *) 6 | 1 [Count] assign Count 1 =. 7 | -------------------------------------------------------------------------------- /test2/fclose.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fclose.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "fclose.joy" "r" fopen fclose. 7 | -------------------------------------------------------------------------------- /test2/feof.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : feof.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "feof.joy" "r" fopen feof false =. 7 | -------------------------------------------------------------------------------- /test2/file.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : file.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 file false =. 7 | stdin file. 8 | -------------------------------------------------------------------------------- /test2/float.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : float.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 float false =. 7 | 1.1 float. 8 | -------------------------------------------------------------------------------- /test2/list.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : list.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [1 2 3] list. 7 | 10 list false =. 8 | -------------------------------------------------------------------------------- /test2/localtime.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : localtime.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | time localtime 6 take. 7 | -------------------------------------------------------------------------------- /test2/set.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : set.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | {1 2 3} set. 7 | 10 set false =. 8 | -------------------------------------------------------------------------------- /test2/srand.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : srand.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | time srand. 7 | rand. 8 | rand. 9 | -------------------------------------------------------------------------------- /test2/swapd.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : swapd.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 swapd stack [3 1 2] equal. 7 | -------------------------------------------------------------------------------- /test2/__latex_manual.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __latex_manual.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | __latex_manual. 7 | -------------------------------------------------------------------------------- /test2/app3.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : app3.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 4 [succ] app3 stack [5 4 3] equal. 7 | -------------------------------------------------------------------------------- /test2/body.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : body.joy 3 | version : 1.5 4 | date : 04/19/24 5 | *) 6 | [sum] first body [0 [+] fold] equal. 7 | -------------------------------------------------------------------------------- /test2/cos.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : cos.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 0.5 cos 'g 0 6 formatf strtod 0.877583 =. 7 | -------------------------------------------------------------------------------- /test2/exp.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : exp.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 exp 'g 0 6 formatf strtod 4.48169 =. 7 | -------------------------------------------------------------------------------- /test2/fgetch.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fgetch.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "fgetch.joy" "r" fopen fgetch '( =. 7 | -------------------------------------------------------------------------------- /test2/floor.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : floor.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 floor 1 =. 7 | -1.5 floor -2 =. 8 | -------------------------------------------------------------------------------- /test2/format.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : format.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 'd 10 10 format "0000000001" =. 7 | -------------------------------------------------------------------------------- /test2/log.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : log.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 10.0 log 'g 0 6 formatf strtod 2.30259 =. 7 | -------------------------------------------------------------------------------- /test2/rand.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rand.joy 3 | version : 1.5 4 | date : 04/11/24 5 | *) 6 | 1 srand. 7 | rand (* 1481765933 = *). 8 | -------------------------------------------------------------------------------- /test2/rollup.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rollup.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 rollup stack [2 1 3] equal. 7 | -------------------------------------------------------------------------------- /test2/rotate.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rotate.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 rotate stack [1 2 3] equal. 7 | -------------------------------------------------------------------------------- /test2/sin.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : sin.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 0.5 sin 'g 0 6 formatf strtod 0.479426 =. 7 | -------------------------------------------------------------------------------- /test2/tan.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : tan.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 tan 'g 0 6 formatf strtod 14.1014 =. 7 | -------------------------------------------------------------------------------- /test2/trunc.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : trunc.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 trunc 1 =. 7 | -1.5 trunc -1 =. 8 | -------------------------------------------------------------------------------- /test2/while.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : while.joy 3 | version : 1.5 4 | date : 04/15/24 5 | *) 6 | "numlib" libload. 7 | 8 | 19 prime. 9 | -------------------------------------------------------------------------------- /test2/app4.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : app4.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 4 5 [succ] app4 stack [6 5 4 3] equal. 7 | -------------------------------------------------------------------------------- /test2/cosh.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : cosh.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 0.5 cosh 'g 0 6 formatf strtod 1.12763 =. 7 | -------------------------------------------------------------------------------- /test2/ferror.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ferror.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "ferror.joy" "r" fopen ferror false =. 7 | -------------------------------------------------------------------------------- /test2/getenv.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : getenv.joy 3 | version : 1.6 4 | date : 08/12/24 5 | *) 6 | "PATH" getenv. 7 | "DUMMY" getenv "" =. 8 | -------------------------------------------------------------------------------- /test2/integer.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : integer.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.0 integer false =. 7 | 10 integer. 8 | -------------------------------------------------------------------------------- /test2/nullary.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : nullary.joy 3 | version : 1.7 4 | date : 03/21/24 5 | *) 6 | 2 20 [] nullary stack [20 20 2] equal. 7 | -------------------------------------------------------------------------------- /test2/pick.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : pick.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 10 pick 1 =. 7 | 1 2 3 4 5 2 pick 3 =. 8 | -------------------------------------------------------------------------------- /test2/pow.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : pow.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 2.5 pow 'g 0 6 formatf strtod 2.75568 =. 7 | -------------------------------------------------------------------------------- /test2/rolldown.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rolldown.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 rolldown stack [1 3 2] equal. 7 | -------------------------------------------------------------------------------- /test2/rollupd.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rollupd.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 4 rollupd stack [4 2 1 3] equal. 7 | -------------------------------------------------------------------------------- /test2/rotated.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rotated.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 4 rotated stack [4 1 2 3] equal. 7 | -------------------------------------------------------------------------------- /test2/sinh.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : sinh.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 0.5 sinh 'g 0 6 formatf strtod 0.521095 =. 7 | -------------------------------------------------------------------------------- /test2/sqrt.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : sqrt.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 sqrt 'g 0 6 formatf strtod 1.22474 =. 7 | -------------------------------------------------------------------------------- /test2/string.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : string.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "test" string. 7 | 10 string false =. 8 | -------------------------------------------------------------------------------- /test2/tanh.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : tanh.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 tanh 'g 0 6 formatf strtod 0.905148 =. 7 | -------------------------------------------------------------------------------- /test2/unary2.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unary2.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 [succ] unary2 stack [4 3] equal. 7 | -------------------------------------------------------------------------------- /test2/unary3.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unary3.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 4 [succ] unary3 stack [5 4 3] equal. 7 | -------------------------------------------------------------------------------- /test2/app12.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : app12.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 1 2 3 4 [over +] app12 stack [6 5 1] equal. 7 | -------------------------------------------------------------------------------- /test2/atan2.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : atan2.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 0.9 0.1 atan2 'g 0 6 formatf strtod 1.46014 =. 7 | -------------------------------------------------------------------------------- /test2/char.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : char.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 10 char false =. 7 | '\n char. 8 | '\010 char. 9 | -------------------------------------------------------------------------------- /test2/i.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : i.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 2 3 [+] i 5 =. 7 | 8 | 2 3 [] i stack [3 2] equal. 9 | -------------------------------------------------------------------------------- /test2/log10.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : log10.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.5 log10 'g 0 6 formatf strtod 0.176091 =. 7 | -------------------------------------------------------------------------------- /test2/unary4.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unary4.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 3 4 5 [succ] unary4 stack [6 5 4 3] equal. 7 | -------------------------------------------------------------------------------- /test2/undeferror.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : undeferror.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 setundeferror. 7 | undeferror 1 =. 8 | -------------------------------------------------------------------------------- /test2/user.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : user.joy 3 | version : 1.5 4 | date : 04/19/24 5 | *) 6 | [sum] first user. 7 | [pop] first user false =. 8 | -------------------------------------------------------------------------------- /test2/__memorymax.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __memorymax.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 0 1 2 3 4 5 6 7 8 9 10 7 | __memorymax. 8 | -------------------------------------------------------------------------------- /test2/__settracegc.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __settracegc.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 0 __settracegc. 7 | 1 __settracegc. 8 | -------------------------------------------------------------------------------- /test2/binrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : binrec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 10 [dup small] [] [pred dup pred] [+] binrec 55 =. 7 | -------------------------------------------------------------------------------- /test2/fremove.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fremove.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | "test" "w" fopen fclose. 7 | "test" fremove. 8 | -------------------------------------------------------------------------------- /test2/ftell.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ftell.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | "ftell.joy" "r" fopen 0 2 fseek swap ftell 121 =. 7 | -------------------------------------------------------------------------------- /test2/linrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : linrec.joy 3 | version : 1.10 4 | date : 04/15/24 5 | *) 6 | 1 10 from-to-list [1 2 3 4 5 6 7 8 9 10] equal. 7 | -------------------------------------------------------------------------------- /test2/rolldownd.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rolldownd.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 2 3 4 rolldownd stack [4 1 3 2] equal. 7 | -------------------------------------------------------------------------------- /test2/setundeferror.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : setundeferror.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 1 setundeferror. 7 | undeferror 1 =. 8 | -------------------------------------------------------------------------------- /test2/__memoryindex.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : __memoryindex.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 0 1 2 3 4 5 6 7 8 9 10 7 | __memoryindex. 8 | -------------------------------------------------------------------------------- /test2/at.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : at.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [4 5 6] 2 at 6 =. 7 | "test" 2 at 's =. 8 | {4 5 6} 2 at 6 =. 9 | -------------------------------------------------------------------------------- /test2/of.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : of.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 [4 5 6] of 6 =. 7 | 2 "test" of 's =. 8 | 2 {4 5 6} of 6 =. 9 | -------------------------------------------------------------------------------- /test2/unstack.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unstack.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [1 2 3] unstack 7 | 1 =. 8 | 2 =. 9 | 3 =. 10 | -------------------------------------------------------------------------------- /test2/choice.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : choice.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | true 1.5 2.5 choice 1.5 =. 7 | false 1.5 2.5 choice 2.5 =. 8 | -------------------------------------------------------------------------------- /test2/fopen.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fopen.joy 3 | version : 1.5 4 | date : 04/15/24 5 | *) 6 | "fopen.joy" "r" fopen dup putln file. 7 | "exist" "r" fopen. 8 | -------------------------------------------------------------------------------- /test2/logical.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : logical.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | false logical. 7 | true logical. 8 | {} logical false =. 9 | -------------------------------------------------------------------------------- /test2/fseek.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fseek.joy 3 | version : 1.6 4 | date : 04/15/24 5 | *) 6 | "fseek.joy" "r" fopen 7 0 fseek not putln fgets 6 take "module" =. 7 | -------------------------------------------------------------------------------- /test2/ifte.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ifte.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | [0 not] [true] [false] ifte. 7 | [1 not] [true] [false] ifte false =. 8 | -------------------------------------------------------------------------------- /test2/round.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : round.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | -1.5 round -2 =. 7 | 1.5 round 2 =. 8 | 9 | 2 round 2 =. 10 | -------------------------------------------------------------------------------- /test2/branch.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : branch.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 0 not [true] [false] branch. 7 | 1 not [true] [false] branch false =. 8 | -------------------------------------------------------------------------------- /test2/fread.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fread.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "fread.joy" "r" fopen 10 fread [40 42 10 32 32 32 32 109 111 100] equal. 7 | -------------------------------------------------------------------------------- /test2/frename.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : frename.joy 3 | version : 1.5 4 | date : 03/22/24 5 | *) 6 | "test" "w" fopen fclose. 7 | "test" "dummy" frename. 8 | $ rm dummy 9 | -------------------------------------------------------------------------------- /test2/argv.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : argv.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | argv 0 at [dup '. has] [dup size 4 - take] # strip .joy 7 | [] ifte "argv" =. 8 | -------------------------------------------------------------------------------- /test2/frexp.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : frexp.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 1.5 frexp stack [1 0.75] equal. 7 | pop pop. 8 | 2 frexp stack [2 0.5] equal. 9 | -------------------------------------------------------------------------------- /test2/neg.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : neg.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 neg -1 =. 7 | 1.5 neg -1.5 =. 8 | -1 neg 1 =. 9 | -1.5 neg 1.5 =. 10 | -------------------------------------------------------------------------------- /test2/cons.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : cons.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 [2 3] cons [1 2 3] equal. 7 | 't "est" cons "test" =. 8 | 1 {2 3} cons {1 2 3} =. 9 | -------------------------------------------------------------------------------- /test2/fwrite.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fwrite.joy 3 | version : 1.7 4 | date : 03/22/24 5 | *) 6 | "test" "w" fopen [34 65 66 67 34 10] fwrite fclose. 7 | $ cat test 8 | $ rm test 9 | -------------------------------------------------------------------------------- /lib/gcd.joy: -------------------------------------------------------------------------------- 1 | #!../build/joy 2 | 3 | argv rest [10 strtol] map uncons uncons pop # get two params 4 | [0 >] [dup rollup rem] while pop # find gcd 5 | put '\n putch. 6 | quit. 7 | -------------------------------------------------------------------------------- /test2/filetime.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : filetime.joy 3 | version : 1.4 4 | date : 08/12/24 5 | *) 6 | "filetime.joy" filetime localtime "%c%n" strftime. 7 | "exist" filetime null. 8 | -------------------------------------------------------------------------------- /test2/fput.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fput.joy 3 | version : 1.8 4 | date : 03/22/24 5 | *) 6 | "test" "w" fopen [1 2 3] fput 10 fput '. ord fputch fclose. 7 | $ cat test 8 | $ rm test 9 | -------------------------------------------------------------------------------- /test2/fputch.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fputch.joy 3 | version : 1.6 4 | date : 03/22/24 5 | *) 6 | "test" "w" fopen 39 fputch 65 fputch 10 fputch fclose. 7 | $ cat test 8 | $ rm test 9 | -------------------------------------------------------------------------------- /test2/fputchars.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fputchars.joy 3 | version : 1.6 4 | date : 03/22/24 5 | *) 6 | "test" "w" fopen "\"test\"\n" fputchars fclose. 7 | $ cat test 8 | $ rm test 9 | -------------------------------------------------------------------------------- /test2/fputstring.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : fputstring.joy 3 | version : 1.6 4 | date : 03/22/24 5 | *) 6 | "test" "w" fopen "\"test\"\n" fputstring fclose. 7 | $ cat test 8 | $ rm test 9 | -------------------------------------------------------------------------------- /test2/gc.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : gc.joy 3 | version : 1.15 4 | date : 11/20/24 5 | *) 6 | __memoryindex 7 | 1 14000 from-to-list pop 8 | gc gc gc gc gc 9 | __memorymax <. 10 | -------------------------------------------------------------------------------- /test2/rem.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rem.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 54 24 rem 6 =. 7 | 54.0 24.0 rem 6 =. 8 | 54 24.0 rem 6 =. 9 | 54.0 24 rem 6 =. 10 | -------------------------------------------------------------------------------- /test2/swons.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : swons.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [2 3] 1 swons [1 2 3] equal. 7 | "est" 't swons "test" =. 8 | {2 3} 1 swons {1 2 3} =. 9 | -------------------------------------------------------------------------------- /test2/system.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : system2.joy 3 | version : 1.5 4 | date : 07/15/24 5 | *) 6 | "TECO" system. 7 | "ls" system. 8 | # "c:/Users/M/AppData/Local/Pandoc/ls" system. 9 | -------------------------------------------------------------------------------- /test2/cleave.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : cleave.joy 3 | version : 1.8 4 | date : 04/15/24 5 | *) 6 | [1.0 2.0 3.0] average 2 =. 7 | [4.0 5.0 6.0] average 5 =. 8 | [7.0 8.0 9.0] average 8 =. 9 | -------------------------------------------------------------------------------- /test2/genrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : genrec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE g-fib == [dup small] [] [pred dup pred] [app2 +] genrec. 7 | 8 | 10 g-fib 55 =. 9 | -------------------------------------------------------------------------------- /test2/ifset.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ifset.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | {1 2 3} ["ifset"] ["noset"] ifset "ifset" =. 7 | [] ["ifset"] ["noset"] ifset "noset" =. 8 | -------------------------------------------------------------------------------- /test2/mul.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : mul.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 3 100 * 300 =. 7 | 3.14 100.0 * 314 =. 8 | 3.14 100 * 314 =. 9 | 100 3.14 * 314 =. 10 | -------------------------------------------------------------------------------- /test2/plus.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : plus.joy 3 | version : 1.7 4 | date : 03/21/24 5 | *) 6 | 2 3 + 5 =. 7 | 'A 2 + 'C =. 8 | 2.1 3.1 + 5.2 =. 9 | 2 3.0 + 5 =. 10 | 2.0 3 + 5 =. 11 | -------------------------------------------------------------------------------- /test2/tailrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : tailrec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [] 0 [dup 10 =] [pop] [dup [swons] dip succ] tailrec 7 | [9 8 7 6 5 4 3 2 1 0] equal. 8 | -------------------------------------------------------------------------------- /test2/undefs.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : undefs.joy 3 | version : 1.7 4 | date : 07/02/24 5 | *) 6 | "undefined" intern [undefined] first =. 7 | [undefined] ["undefined"] equal. 8 | undefs. 9 | -------------------------------------------------------------------------------- /test2/x.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : x.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | DEFINE test == [pop succ] x. 7 | 8 | 2 test 3 =. 9 | 10 | 2 [] x stack [[] 2] equal. 11 | -------------------------------------------------------------------------------- /test2/atan.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : atan.joy 3 | version : 1.5 4 | date : 09/19/24 5 | *) 6 | 0.1 atan 'g 0 6 formatf strtod 0.0996687 =. 7 | 8 | 0.1 # x 9 | 1.0 # 1 10 | atan2. 11 | -------------------------------------------------------------------------------- /test2/dip.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : dip.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 2 3 4 [+] dip stack [4 5] equal. 7 | 8 | [] unstack. 9 | 2 3 4 [] dip stack [4 3 2] equal. 10 | -------------------------------------------------------------------------------- /test2/ifchar.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ifchar.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 'A ["ischar"] ["nochar"] ifchar "ischar" =. 7 | 10 ["ischar"] ["nochar"] ifchar "nochar" =. 8 | -------------------------------------------------------------------------------- /test2/iffile.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : iffile.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | stdin ["isfile"] ["nofile"] iffile "isfile" =. 7 | 10 ["isfile"] ["nofile"] iffile "nofile" =. 8 | -------------------------------------------------------------------------------- /test2/minus.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : minus.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 2 3 - -1 =. 7 | 'A 1 - '@ =. 8 | 2.0 3.0 - -1 =. 9 | 2 3.0 - -1 =. 10 | 2.0 3 - -1 =. 11 | -------------------------------------------------------------------------------- /test2/mktime.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : mktime.joy 3 | version : 1.5 4 | date : 07/14/24 5 | *) 6 | time dup 7 | dup putln 8 | gmtime 9 | dup putln 10 | mktime 11 | dup putln 12 | =. 13 | -------------------------------------------------------------------------------- /test2/unary.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unary.joy 3 | version : 1.6 4 | date : 04/15/24 5 | *) 6 | "numlib" libload. 7 | 8 | 10 fib 55 =. 9 | 10 | 2 20 [] unary stack [20 2] equal. 11 | -------------------------------------------------------------------------------- /test2/iflist.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : iflist.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [1 2 3] ["islist"] ["nolist"] iflist "islist" =. 7 | 10 ["islist"] ["nolist"] iflist "nolist" =. 8 | -------------------------------------------------------------------------------- /test2/setecho.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : setecho.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 setecho. 7 | echo 1 =. 8 | 2 setecho. 9 | echo 2 =. 10 | 3 setecho. 11 | echo 3 =. 12 | -------------------------------------------------------------------------------- /test2/binary.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : binary.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 3 4 5 [+] binary stack [9 3] equal. 7 | 8 | [] unstack. 9 | 3 4 5 [] binary stack [5 3] equal. 10 | -------------------------------------------------------------------------------- /test2/iffloat.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : iffloat.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.0 ["isfloat"] ["nofloat"] iffloat "isfloat" =. 7 | 10 ["isfloat"] ["nofloat"] iffloat "nofloat" =. 8 | -------------------------------------------------------------------------------- /test2/intern.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : intern.joy 3 | version : 1.6 4 | date : 08/29/24 5 | *) 6 | 1 "succ" intern [] cons i 2 =. 7 | 8 | (* The next intern is not allowed *) 9 | # "1 2 3" intern. 10 | -------------------------------------------------------------------------------- /test2/first.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : first.joy 3 | version : 1.5 4 | date : 08/29/24 5 | *) 6 | [1 2 3] first 1 =. 7 | "test" first 't =. 8 | {1 2 3} first 1 =. 9 | 10 | (* error *) 11 | # 10 first. 12 | -------------------------------------------------------------------------------- /test2/rest.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : rest.joy 3 | version : 1.6 4 | date : 08/29/24 5 | *) 6 | [1 2 3] rest [2 3] equal. 7 | "test" rest "est" =. 8 | {1 2 3} rest {2 3} =. 9 | 10 | (* error *) 11 | # 'A rest. 12 | -------------------------------------------------------------------------------- /test2/treestep.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : treestep.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE treesample == [[1 2 [3 4] 5 [[[6]]] 7] 8]. 7 | 8 | [] treesample [swons] treestep [8 7 6 5 4 3 2 1] equal. 9 | -------------------------------------------------------------------------------- /test2/ifinteger.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ifinteger.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1.0 ["isinteger"] ["nointeger"] ifinteger "nointeger" =. 7 | 10 ["isinteger"] ["nointeger"] ifinteger "isinteger" =. 8 | -------------------------------------------------------------------------------- /test2/iflogical.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : iflogical.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | true ["islogical"] ["nological"] iflogical "islogical" =. 7 | 1 ["islogical"] ["nological"] iflogical "nological" =. 8 | -------------------------------------------------------------------------------- /test2/ternary.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ternary.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 1 2 3 4 5 [+] ternary stack [9 2 1] equal. 7 | 8 | [] unstack. 9 | 1 2 3 4 5 [] ternary stack [5 2 1] equal. 10 | -------------------------------------------------------------------------------- /lib/alljoy.joy: -------------------------------------------------------------------------------- 1 | "numlib.joy" include. 2 | "seqlib.joy" include. 3 | "symlib.joy" include. 4 | "lsplib.joy" include. 5 | "lazlib.joy" include. 6 | "tutlib.joy" include. 7 | "mtrlib.joy" include. 8 | "seqlib.joy" include. 9 | help. 10 | -------------------------------------------------------------------------------- /test2/construct.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : construct.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE test == [2.0 3.0] [[+] [*] [-] [/]] construct. 7 | 8 | test 'g 0 6 formatf strtod stack [0.666667 -1 6 5] equal. 9 | -------------------------------------------------------------------------------- /test2/divide.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : divide.joy 3 | version : 1.6 4 | date : 08/29/24 5 | *) 6 | 54 24 / 2 =. 7 | 54.0 24.0 / 2.25 =. 8 | 54.0 24 / 2.25 =. 9 | 54 24.0 / 2.25 =. 10 | 11 | (* error *) 12 | # 1 0 /. 13 | -------------------------------------------------------------------------------- /test2/setautoput.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : setautoput.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 setautoput. 7 | autoput 1 =. 8 | 0 1 2 3 4 5 6 7 8 9 10 10 =. 9 | 2 setautoput 10 | autoput 2 = put abort. 11 | -------------------------------------------------------------------------------- /test2/sign.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : sign.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 1.0 sign 1 =. 7 | 0.0 sign 0 =. 8 | -0.0 sign 0 =. 9 | -1.0 sign -1 =. 10 | 2 sign 1 =. 11 | 0 sign 0 =. 12 | -2 sign -1 =. 13 | -------------------------------------------------------------------------------- /test2/in.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : in.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 2 [1 2 3] in. 7 | 4 [1 2 3] in false =. 8 | 'e "test" in. 9 | 'a "test" in false =. 10 | 2 {1 2 3} in. 11 | 4 {1 2 3} in false =. 12 | -------------------------------------------------------------------------------- /test2/treerec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : treerec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE treesample == [[1 2 [3 4] 5 [[[6]]] 7] 8]. 7 | 8 | treesample [dup *] [map] treerec [[1 4 [9 16] 25 [[[36]]] 49] 64] equal. 9 | -------------------------------------------------------------------------------- /test2/has.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : has.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [1 2 3] 2 has. 7 | [1 2 3] 4 has false =. 8 | "test" 'e has. 9 | "test" 'a has false =. 10 | {1 2 3} 2 has. 11 | {1 2 3} 4 has false =. 12 | -------------------------------------------------------------------------------- /test2/enconcat.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : enconcat.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | 1 [2 3 4] [5 6 7] enconcat [2 3 4 1 5 6 7] equal. 7 | 'a "test" "uftu" enconcat "testauftu" =. 8 | 1 {2 3 4} {5 6 7} enconcat {1 2 3 4 5 6 7} =. 9 | -------------------------------------------------------------------------------- /test2/ldexp.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ldexp.joy 3 | version : 1.6 4 | date : 10/13/24 5 | *) 6 | "prelib" libload. 7 | 8 | 1.5 2 ldexp 6 =. 9 | 2.5 4 ldexp 40 =. 10 | 11 | (* Rosettacode.org *) 12 | 1 1024 ldexp dup neg stack [-inf inf] equal. 13 | -------------------------------------------------------------------------------- /test2/or.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : or.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | false false or false =. 7 | false true or. 8 | true false or. 9 | true true or. 10 | {1 2 3} {4 5 6} or {1 2 3 4 5 6} =. 11 | {1 2 3} {2 3 4} or {1 2 3 4} =. 12 | -------------------------------------------------------------------------------- /test2/strtol.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : strtol.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "10" 0 strtol 10 =. 7 | "010" 0 strtol 8 =. 8 | "0x10" 0 strtol 16 =. 9 | "377" 8 strtol 255 =. 10 | "ff" 16 strtol 255 =. 11 | "255" 10 strtol 255 =. 12 | -------------------------------------------------------------------------------- /test2/times.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : times.joy 3 | version : 1.8 4 | date : 08/29/24 5 | *) 6 | "numlib" libload. 7 | 8 | 10 fib 55 =. 9 | 10 | 1 10 [] times 1 =. 11 | 12 | 1 0 [succ] times 1 =. 13 | 14 | (* error *) 15 | # 1 -1 [succ] times. 16 | -------------------------------------------------------------------------------- /test2/unassign.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unassign.joy 3 | version : 1.3 4 | date : 08/29/24 5 | *) 6 | 1 [Count] assign 7 | [Count] unassign 8 | "Count" intern body null. 9 | 10 | (* error *) 11 | # unassign. 12 | 13 | 0 setundeferror. 14 | Count. 15 | -------------------------------------------------------------------------------- /test2/asin.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : asin.joy 3 | version : 1.5 4 | date : 09/19/24 5 | *) 6 | 0.1 asin 'g 0 6 formatf strtod 0.100167 =. 7 | 8 | 0.1 # x 9 | dup # 10 | dup 11 | * # x^2 12 | 1.0 # 1 13 | swap 14 | - # 1-x^2 15 | sqrt 16 | atan2. 17 | -------------------------------------------------------------------------------- /test2/helpdetail.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : helpdetail.joy 3 | version : 1.6 4 | date : 04/19/24 5 | *) 6 | "test" "w" fopen 7 | [stdin stdout stderr 3.14 [] "" {} 10 'A true maxint helpdetail sum dummy] 8 | cons helpdetail. 9 | $ cat test 10 | $ rm test 11 | -------------------------------------------------------------------------------- /test2/size.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : size.joy 3 | version : 1.5 4 | date : 08/29/24 5 | *) 6 | [1 2 3] size 3 =. 7 | "test" size 4 =. 8 | {1 2 3} size 3 =. 9 | [] size null. 10 | "" size null. 11 | {} size null. 12 | 13 | (* error *) 14 | # 10 size. 15 | -------------------------------------------------------------------------------- /test2/acos.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : acos.joy 3 | version : 1.5 4 | date : 09/19/24 5 | *) 6 | 0.1 acos 'g 0 6 formatf strtod 1.47063 =. 7 | 8 | 0.1 # x 9 | dup # 10 | dup # 11 | * # x^2 12 | 1.0 13 | swap 14 | - # 1-x^2 15 | sqrt 16 | swap 17 | atan2. 18 | -------------------------------------------------------------------------------- /test2/and.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : and.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | false false and false =. 7 | false true and false =. 8 | true false and false =. 9 | true true and. 10 | {1 2 3} {4 5 6} and {} =. 11 | {1 2 3} {2 3 4} and {2 3} =. 12 | -------------------------------------------------------------------------------- /test2/include.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : include.joy 3 | version : 1.5 4 | date : 08/29/24 5 | *) 6 | DEFINE _include == true. 7 | 8 | ["_include" intern body null] 9 | ["include.joy" include] [] ifte. 10 | _include. 11 | 12 | (* error *) 13 | # "exist" include. 14 | -------------------------------------------------------------------------------- /test2/xor.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : xor.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | false false xor false =. 7 | false true xor. 8 | true false xor. 9 | true true xor false =. 10 | {1 2 3} {4 5 6} xor {1 2 3 4 5 6} =. 11 | {1 2 3} {2 3 4} xor {1 4} =. 12 | -------------------------------------------------------------------------------- /test2/ifstring.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : ifstring.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | "test" ["isstring"] ["nostring"] ifstring "isstring" =. 7 | [test] first ["isstring"] ["nostring"] ifstring "nostring" =. 8 | 10 ["isstring"] ["nostring"] ifstring "nostring" =. 9 | -------------------------------------------------------------------------------- /test2/put.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : put.joy 3 | version : 1.6 4 | date : 04/19/24 5 | *) 6 | [pop] first putln. 7 | [sum] first putln. 8 | true putln. 9 | 'A putln. 10 | 10 putln. 11 | {1 2 3} putln. 12 | "test" putln. 13 | [1 2 3] putln. 14 | 3.14 putln. 15 | stdin putln. 16 | -------------------------------------------------------------------------------- /test2/uncons.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : uncons.joy 3 | version : 1.6 4 | date : 08/29/24 5 | *) 6 | [1 2 3] uncons stack [[2 3] 1] equal. 7 | pop pop "test" uncons stack ["est" 't] equal. 8 | pop pop {1 2 3} uncons stack [{2 3} 1] equal. 9 | 10 | (* error *) 11 | # 'A uncons. 12 | -------------------------------------------------------------------------------- /test2/condnestrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : condnestrec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE cnr-ack == [[[over null] [popd succ]] 7 | [[dup null] [pop pred 1] []] 8 | [[[dup pred swap] dip pred] [] []]] condnestrec. 9 | 10 | 3 4 cnr-ack 125 =. 11 | -------------------------------------------------------------------------------- /test2/treegenrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : treegenrec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE treemap == [] [map] treegenrec; 7 | treesample == [[1 2 [3 4] 5 [[[6]]] 7] 8]. 8 | 9 | 0 treesample [[dup] dip -] treemap [[-1 -2 [-3 -4] -5 [[[-6]]] -7] -8] equal. 10 | -------------------------------------------------------------------------------- /test2/case.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : case.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | DEFINE test == [[1 [one] first] 7 | [2 [two] first] 8 | [[other] first]] case. 9 | 10 | 1 test stack [one] equal. 11 | pop 2 test stack [two] equal. 12 | pop 3 test stack [other 3] equal. 13 | -------------------------------------------------------------------------------- /src/gc.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : gc.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef GC_C 7 | #define GC_C 8 | 9 | /** 10 | Q0 IGNORE_OK 3010 gc : N -> 11 | [IMPURE] Initiates garbage collection. 12 | */ 13 | void gc_(pEnv env) 14 | { 15 | GC_gcollect(); 16 | } 17 | #endif 18 | -------------------------------------------------------------------------------- /test2/finclude.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : finclude.joy 3 | version : 1.1 4 | date : 06/21/24 5 | *) 6 | "test" "w" fopen 7 | 1 fput '\n fputch 8 | 2 fput '\n fputch 9 | 3 fput '\n fputch 10 | fclose 11 | "test" finclude 12 | stack [3 2 1] equal. 13 | "test" fremove. 14 | 15 | "exist" finclude. 16 | -------------------------------------------------------------------------------- /test2/max.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : max.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 'A 'B max 'B =. 7 | 'B 'A max 'B =. 8 | 1 2 max 2 =. 9 | 2 1 max 2 =. 10 | 1.5 2.5 max 2.5 =. 11 | 2.5 1.5 max 2.5 =. 12 | 1 2.5 max 2.5 =. 13 | 2 1.5 max 2 =. 14 | 2.5 1 max 2.5 =. 15 | 1.5 2 max 2 =. 16 | -------------------------------------------------------------------------------- /test2/min.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : min.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 'A 'B min 'A =. 7 | 'B 'A min 'A =. 8 | 1 2 min 1 =. 9 | 2 1 min 1 =. 10 | 1.5 2.5 min 1.5 =. 11 | 2.5 1.5 min 1.5 =. 12 | 1 2.5 min 1 =. 13 | 2 1.5 min 1.5 =. 14 | 1.5 2 min 1.5 =. 15 | 2.5 1 min 1 =. 16 | -------------------------------------------------------------------------------- /test2/condlinrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : condlinrec.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | DEFINE ack == [[[dup null] [pop succ]] 7 | [[over null] [popd pred 1 swap] []] 8 | [[dup rollup [pred] dip] [swap pred ack]]] condlinrec. 9 | 10 | [[4 0]] [i swap ack] map [13] equal. 11 | -------------------------------------------------------------------------------- /test2/primrec.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : primrec.joy 3 | version : 1.5 4 | date : 08/29/24 5 | *) 6 | [1 2 3 4 5] [0] [+] primrec 15 =. 7 | 5 [1] [*] primrec 120 =. 8 | "test" [""] [cons] primrec "test" =. 9 | {1 2 3} [{}] [cons] primrec {1 2 3} =. 10 | 11 | (* error *) 12 | # 'A [] [] primrec. 13 | -------------------------------------------------------------------------------- /test2/unswons.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : unswons.joy 3 | version : 1.7 4 | date : 08/29/24 5 | *) 6 | [1 2 3] unswons 7 | 1 =. 8 | [2 3] equal. 9 | "test" unswons 10 | 't =. 11 | "est" =. 12 | {1 2 3} unswons 13 | 1 =. 14 | {2 3} =. 15 | 16 | [1] unswons 1 =. 17 | 18 | (* error *) 19 | # 'A unswons. 20 | -------------------------------------------------------------------------------- /test2/drop.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : drop.joy 3 | version : 1.8 4 | date : 08/29/24 5 | *) 6 | [1 2 3] 1 drop [2 3] equal. 7 | "test" 1 drop "est" =. 8 | {1 2 3} 1 drop {2 3} =. 9 | 10 | [1 2 3] 5 drop [] equal. 11 | "test" 5 drop "" =. 12 | {1 2 3} 5 drop {} =. 13 | 14 | (* error *) 15 | # 'A 10 drop. 16 | -------------------------------------------------------------------------------- /test2/infra.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : infra.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | DEFINE test == [] [2 3 + 4 5 *] infra. 7 | 8 | 1 2 3 4 5 test stack [[20 5] 5 4 3 2 1] equal. 9 | 10 | DEFINE test1 == [6 7 8 9 10] [] infra. 11 | 12 | [] unstack. 13 | 14 | test1 stack [[6 7 8 9 10]] equal. 15 | -------------------------------------------------------------------------------- /test1/const.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : const.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | CONST 7 | Ctrl-Q == 17; 8 | Ctrl-S == 19; 9 | Ctrl-F == 6. 10 | 11 | DEFINE 12 | Ctrl-X == 24; 13 | Ctrl-Z == 26. 14 | 15 | [Ctrl-Q Ctrl-S Ctrl-F Ctrl-X Ctrl-Z]. 16 | 17 | {Ctrl-Q Ctrl-S Ctrl-F Ctrl-X 'A} size. 18 | -------------------------------------------------------------------------------- /src/quit.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : quit.c 3 | version : 1.15 4 | date : 09/17/24 5 | */ 6 | #ifndef QUIT_C 7 | #define QUIT_C 8 | 9 | /** 10 | Q0 IGNORE_OK 3130 quit : N -> 11 | Exit from Joy. 12 | */ 13 | void quit_(pEnv env) 14 | { 15 | abortexecution_(ABORT_QUIT); 16 | } /* LCOV_EXCL_LINE */ 17 | #endif 18 | -------------------------------------------------------------------------------- /test1/quad.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : quad.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | DEFINE 7 | quad == [C] assign neg [B] assign 2 * [A] assign 8 | B dup * 2 A C * * - 9 | [0 <] ["determinant is negative\n" putchars abort] [] ifte 10 | sqrt [R] assign 11 | B R + A / 12 | B R - A /. 13 | 14 | 2 -4 -6 quad.. 15 | -------------------------------------------------------------------------------- /test2/maxint.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : maxint.joy 3 | version : 1.8 4 | date : 07/15/24 5 | *) 6 | maxint pred 9223372036854775806 =. 7 | 8 | 99999999999999999999 dup 6 casting putln 1.0e20 dup 6 casting putln =. 9 | 10 | 99999999999999999999 99999999999999999999 * dup 6 casting putln 1.0e40 11 | dup 6 casting putln =. 12 | -------------------------------------------------------------------------------- /src/app2.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : app2.c 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef APP2_C 7 | #define APP2_C 8 | 9 | /** 10 | Q1 OK 2530 app2 : DDDAA X1 X2 [P] -> R1 R2 11 | Obsolescent. == unary2 12 | */ 13 | void app2_(pEnv env) 14 | { 15 | unary2_(env); 16 | /* nothing */ 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /src/pop.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : pop.c 3 | version : 1.9 4 | date : 11/20/24 5 | */ 6 | #ifndef POP_C 7 | #define POP_C 8 | 9 | /** 10 | Q0 OK 1320 pop : D X -> 11 | Removes X from top of the stack. 12 | */ 13 | void pop_(pEnv env) 14 | { 15 | PARM(1, ANYTYPE); 16 | vec_reduce(env->stck, 1); 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /src/app3.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : app3.c 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef APP3_C 7 | #define APP3_C 8 | 9 | /** 10 | Q1 OK 2540 app3 : DDDDAAA X1 X2 X3 [P] -> R1 R2 R3 11 | Obsolescent. == unary3 12 | */ 13 | void app3_(pEnv env) 14 | { 15 | unary3_(env); 16 | /* nothing */ 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /test2/typeof.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : typeof.joy 3 | version : 1.4 4 | date : 04/19/24 5 | *) 6 | [sum] first typeof 2 =. 7 | [pop] first typeof 3 =. 8 | true typeof 4 =. 9 | 'A typeof 5 =. 10 | 10 typeof 6 =. 11 | {1 2 3} typeof 7 =. 12 | "test" typeof 8 =. 13 | [1 2 3] typeof 9 =. 14 | 1.1 typeof 10 =. 15 | stdin typeof 11 =. 16 | -------------------------------------------------------------------------------- /src/app4.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : app4.c 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef APP4_C 7 | #define APP4_C 8 | 9 | /** 10 | Q1 OK 2550 app4 : DDDDDAAAA X1 X2 X3 X4 [P] -> R1 R2 R3 R4 11 | Obsolescent. == unary4 12 | */ 13 | void app4_(pEnv env) 14 | { 15 | unary4_(env); 16 | /* nothing */ 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /src/id.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : id.c 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef ID_C 7 | #define ID_C 8 | 9 | /** 10 | Q0 OK 1200 id : N -> 11 | Identity function, does nothing. 12 | Any program of the form P id Q is equivalent to just P Q. 13 | */ 14 | void id_(pEnv env) 15 | { 16 | /* nothing */ 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /src/get.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : get.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef GET_C 7 | #define GET_C 8 | 9 | /** 10 | Q0 POSTPONE 3070 get : A -> F 11 | [IMPURE] Reads a factor from input and pushes it onto stack. 12 | */ 13 | void get_(pEnv env) 14 | { 15 | env->token = yylex(env); 16 | readfactor(env); 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /src/app11.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : app11.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef APP11_C 7 | #define APP11_C 8 | 9 | /** 10 | Q1 OK 2450 app11 : DDDA X Y [P] -> R 11 | Executes P, pushes result R on stack. 12 | */ 13 | void app11_(pEnv env) 14 | { 15 | PARM(3, DIP); 16 | code(env, popd_); 17 | i_(env); 18 | } 19 | #endif 20 | -------------------------------------------------------------------------------- /test2/casting.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : casting.joy 3 | version : 1.4 4 | date : 03/21/24 5 | *) 6 | [pop] first 3 casting [pop] first =. 7 | 1 4 casting. 8 | 66 5 casting 'B =. 9 | 'A 6 casting 65 =. 10 | 123456789 7 casting {0 2 4 8 10 11 14 15 16 17 19 20 22 24 25 26} =. 11 | 0 9 casting [] equal. 12 | 1 10 casting 4.94066e-324 =. 13 | argv 11 casting argv !=. 14 | -------------------------------------------------------------------------------- /src/abort.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : abort.c 3 | version : 1.12 4 | date : 09/17/24 5 | */ 6 | #ifndef ABORT_C 7 | #define ABORT_C 8 | 9 | /** 10 | Q0 IGNORE_OK 3120 abort : N -> 11 | Aborts execution of current Joy program, returns to Joy main cycle. 12 | */ 13 | void abort_(pEnv env) 14 | { 15 | abortexecution_(ABORT_RETRY); 16 | } /* LCOV_EXCL_LINE */ 17 | #endif 18 | -------------------------------------------------------------------------------- /src/i.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : i.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef I_C 7 | #define I_C 8 | 9 | /** 10 | Q1 OK 2410 i : DP [P] -> ... 11 | Executes P. So, [P] i == P. 12 | */ 13 | void i_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, DIP); 18 | node = vec_pop(env->stck); 19 | prog(env, node.u.lis); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/manual.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : manual.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef MANUAL_C 7 | #define MANUAL_C 8 | 9 | #include "manual.h" 10 | 11 | /** 12 | Q0 IGNORE_OK 2930 manual : N -> 13 | [IMPURE] Writes this manual of all Joy primitives to output file. 14 | */ 15 | void manual_(pEnv env) 16 | { 17 | make_manual(0); 18 | } 19 | #endif 20 | -------------------------------------------------------------------------------- /test2/neql.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : neql.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | 10 11 !=. 7 | 10 10 != false =. 8 | 10 9 !=. 9 | 10 | 10 9.0 !=. 11 | 10.0 9.0 !=. 12 | 10.0 10 != false =. 13 | 14 | "ustu" "test" !=. 15 | [ustu] first "test" !=. 16 | [ustu] first [test] first !=. 17 | "ustu" [test] first !=. 18 | [ustu] first "test" !=. 19 | 20 | stdout stdin !=. 21 | -------------------------------------------------------------------------------- /src/fputstring.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fputstring.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FPUTSTRING_C 7 | #define FPUTSTRING_C 8 | 9 | /** 10 | Q0 OK 1970 fputstring : D S "abc.." -> S 11 | [FOREIGN] == fputchars, as a temporary alternative. 12 | */ 13 | void fputstring_(pEnv env) 14 | { 15 | fputchars_(env); 16 | /* nothing */ 17 | } 18 | #endif 19 | -------------------------------------------------------------------------------- /src/true.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : true.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef TRUE_C 7 | #define TRUE_C 8 | 9 | /** 10 | Q0 IMMEDIATE 1010 true : A -> true 11 | Pushes the value true. 12 | */ 13 | void true_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = 1; 18 | node.op = BOOLEAN_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/false.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : false.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FALSE_C 7 | #define FALSE_C 8 | 9 | /** 10 | Q0 IMMEDIATE 1000 false : A -> false 11 | Pushes the value false. 12 | */ 13 | void false_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = 0; 18 | node.op = BOOLEAN_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /test2/geql.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : geql.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 10 11 >= false =. 7 | 10 10 >=. 8 | 10 9 >=. 9 | 10 | 10 9.0 >=. 11 | 10.0 9.0 >=. 12 | 10.0 10 >=. 13 | 14 | "ustu" "test" >=. 15 | [ustu] first "test" >=. 16 | [ustu] first [test] first >=. 17 | "ustu" [test] first >=. 18 | [ustu] first "test" >=. 19 | 20 | stdout stdin >=. 21 | 123456789 {0} >=. 22 | -------------------------------------------------------------------------------- /test2/greater.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : greater.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 10 11 > false =. 7 | 10 10 > false =. 8 | 10 9 >. 9 | 10 | 10 9.0 >. 11 | 10.0 9.0 >. 12 | 11.0 10 >. 13 | 14 | "ustu" "test" >. 15 | [ustu] first "test" >. 16 | [ustu] first [test] first >. 17 | "ustu" [test] first >. 18 | [ustu] first "test" >. 19 | 20 | stdout stdin >. 21 | 123456789 {0} >. 22 | -------------------------------------------------------------------------------- /src/dup.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : dup.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef DUP_C 7 | #define DUP_C 8 | 9 | /** 10 | Q0 OK 1210 dup : A X -> X X 11 | Pushes an extra copy of X onto stack. 12 | */ 13 | void dup_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_back(env->stck); 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/echo.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : echo.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ECHO_C 7 | #define ECHO_C 8 | 9 | /** 10 | Q0 OK 1120 echo : A -> I 11 | Pushes value of echo flag, I = 0..3. 12 | */ 13 | void echo_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = env->echoflag; 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/rand.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rand.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef RAND_C 7 | #define RAND_C 8 | 9 | /** 10 | Q0 IGNORE_PUSH 1150 rand : A -> I 11 | [IMPURE] I is a random integer. 12 | */ 13 | void rand_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = rand(); 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/x.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : x.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef X_C 7 | #define X_C 8 | 9 | /** 10 | Q1 OK 2420 x : P [P] x -> ... 11 | Executes P without popping [P]. So, [P] x == [P] P. 12 | */ 13 | void x_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, DIP); 18 | node = vec_back(env->stck); 19 | prog(env, node.u.lis); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /test2/name.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : name.joy 3 | version : 1.5 4 | date : 04/19/24 5 | *) 6 | [pop] first name "pop" =. 7 | [sum] first name "sum" =. 8 | true name " truth value type" =. 9 | 'A name " character type" =. 10 | 10 name " integer type" =. 11 | {} name " set type" =. 12 | "" name " string type" =. 13 | [] name " list type" =. 14 | 1.1 name " float type" =. 15 | stdin name " file type" =. 16 | -------------------------------------------------------------------------------- /test2/step.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : step.joy 3 | version : 1.7 4 | date : 08/29/24 5 | *) 6 | 0 [1 2 3] [+] step 6 =. 7 | 0 "test" [swap + ord] step 448 =. 8 | 0 {1 2 3} [+] step 6 =. 9 | 10 | 1 [] [+] step 1 =. 11 | 2 "" [swap + ord] step 2 =. 12 | 3 {} [+] step 3 =. 13 | 14 | 0 [1 2 3] [] step 3 =. 15 | 0 "test" [] step 't =. 16 | 0 {1 2 3} [] step 3 =. 17 | 18 | (* error *) 19 | # 10 [] step. 20 | -------------------------------------------------------------------------------- /src/__dump.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __dump.c 3 | version : 1.9 4 | date : 09/19/24 5 | */ 6 | #ifndef __DUMP_C 7 | #define __DUMP_C 8 | 9 | /** 10 | Q0 OK 1070 __dump : A -> [..] 11 | debugging only: pushes the dump as a list. 12 | */ 13 | void __dump_(pEnv env) 14 | { 15 | Node node; 16 | 17 | vec_init(node.u.lis); 18 | node.op = LIST_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/jump.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : jump.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef JUMP_C 7 | #define JUMP_C 8 | 9 | /** 10 | Q0 OK 3320 #jump : N -> 11 | Pop the jump location from the program stack. Jump to that location. 12 | */ 13 | void jump_(pEnv env) 14 | { 15 | Node jump; 16 | 17 | jump = vec_pop(env->prog); 18 | vec_setsize(env->prog, jump.u.num); 19 | } 20 | #endif 21 | -------------------------------------------------------------------------------- /src/stdin.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : stdin.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef STDIN_C 7 | #define STDIN_C 8 | 9 | /** 10 | Q0 IMMEDIATE 1170 stdin : A -> S 11 | [FOREIGN] Pushes the standard input stream. 12 | */ 13 | void stdin_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.fil = stdin; 18 | node.op = FILE_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /test1/m26.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : m26.joy 3 | version : 1.1 4 | date : 04/12/24 5 | *) 6 | MODULE m3 7 | PRIVATE 8 | a == "A"; 9 | PUBLIC 10 | c == a "B" concat; 11 | END 12 | 13 | MODULE m1 14 | PRIVATE 15 | a == "a"; 16 | PUBLIC 17 | MODULE m2 18 | PUBLIC 19 | b == "b"; 20 | END; 21 | c == m2.b "c" concat; 22 | END 23 | 24 | m3.c. 25 | m1.a. 26 | m2.b. 27 | m1.c. 28 | -------------------------------------------------------------------------------- /test2/all2.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : all2.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | [1 2 3] [2 <] all false =. 7 | [1 2 3] [4 <] all. 8 | "test" ['t <] all false =. 9 | "test" ['u <] all. 10 | {1 2 3} [2 <] all false =. 11 | {1 2 3} [4 <] all. 12 | 13 | [] [2 <] all. 14 | "" ['t <] all. 15 | {} [2 <] all. 16 | 17 | [1 2 3] [] all false =. 18 | "test" [] all false =. 19 | {1 2 3} [] all false =. 20 | -------------------------------------------------------------------------------- /test2/leql.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : leql.joy 3 | version : 1.6 4 | date : 03/21/24 5 | *) 6 | 10 11 <=. 7 | 10 10 <=. 8 | 10 9 <= false =. 9 | 10 | 10 9.0 <= false =. 11 | 10.0 9.0 <= false =. 12 | 10.0 10 <=. 13 | 14 | "test" "ustu" <=. 15 | "test" [ustu] first <=. 16 | [test] first [ustu] first <=. 17 | [test] first "ustu" <=. 18 | "test" [ustu] first <=. 19 | 20 | stdin stdout <=. 21 | {0} 123456789 <=. 22 | -------------------------------------------------------------------------------- /test2/map.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : map.joy 3 | version : 1.7 4 | date : 08/29/24 5 | *) 6 | [1 2 3] [succ] map [2 3 4] equal. 7 | "test" [succ] map "uftu" =. 8 | {1 2 3} [succ] map {2 3 4} =. 9 | 10 | [1 2 3] [] map [1 2 3] equal. 11 | "test" [] map "test" =. 12 | {1 2 3} [] map {1 2 3} =. 13 | 14 | [] [succ] map [] =. 15 | "" [succ] map "" =. 16 | {} [succ] map {} =. 17 | 18 | (* error *) 19 | # 'A [] map. 20 | -------------------------------------------------------------------------------- /src/app1.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : app1.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef APP1_C 7 | #define APP1_C 8 | 9 | /** 10 | Q1 OK 2440 app1 : DDA X [P] -> R 11 | Obsolescent. Executes P, pushes result R on stack. 12 | */ 13 | void app1_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(2, DIP); 18 | node = vec_pop(env->stck); 19 | prog(env, node.u.lis); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/stderr.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : stderr.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef STDERR_C 7 | #define STDERR_C 8 | 9 | /** 10 | Q0 IMMEDIATE 1190 stderr : A -> S 11 | [FOREIGN] Pushes the standard error stream. 12 | */ 13 | void stderr_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.fil = stderr; 18 | node.op = FILE_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /test2/less.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : less.joy 3 | version : 1.7 4 | date : 03/21/24 5 | *) 6 | 10 11 <. 7 | 10 10 < false =. 8 | 10 9 < false =. 9 | 10 | 10 9.0 < false =. 11 | 10.0 9.0 < false =. 12 | 10.0 10 < false =. 13 | 14 | "test" "ustu" <. 15 | "test" [ustu] first <. 16 | [test] first [ustu] first <. 17 | [test] first "ustu" <. 18 | "test" [ustu] first <. 19 | 20 | stdin stdout <. 21 | {0} 123456789 <. 22 | -------------------------------------------------------------------------------- /src/fclose.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fclose.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FCLOSE_C 7 | #define FCLOSE_C 8 | 9 | /** 10 | Q0 OK 1830 fclose : D S -> 11 | [FOREIGN] Stream S is closed and removed from the stack. 12 | */ 13 | void fclose_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, FGET); 18 | node = vec_pop(env->stck); 19 | fclose(node.u.fil); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/srand.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : srand.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef SRAND_C 7 | #define SRAND_C 8 | 9 | /** 10 | Q0 IGNORE_POP 1780 srand : D I -> 11 | [IMPURE] Sets the random integer seed to integer I. 12 | */ 13 | void srand_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UNMKTIME); 18 | node = vec_pop(env->stck); 19 | srand(node.u.num); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/stdout.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : stdout.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef STDOUT_C 7 | #define STDOUT_C 8 | 9 | /** 10 | Q0 IMMEDIATE 1180 stdout : A -> S 11 | [FOREIGN] Pushes the standard output stream. 12 | */ 13 | void stdout_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.fil = stdout; 18 | node.op = FILE_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/treerec.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : treerec.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef TREEREC_C 7 | #define TREEREC_C 8 | 9 | /** 10 | Q2 OK 2880 treerec : DDDA T [O] [C] -> ... 11 | T is a tree. If T is a leaf, executes O. Else executes [[[O] C] treerec] C. 12 | */ 13 | void treerec_(pEnv env) 14 | { 15 | PARM(3, WHILE); 16 | cons_(env); 17 | treerecaux_(env); 18 | } 19 | #endif 20 | -------------------------------------------------------------------------------- /test2/sametype.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : sametype.joy 3 | version : 1.7 4 | date : 04/15/24 5 | *) 6 | [sum] first [average] first sametype. 7 | [pop] first [pop] first sametype. 8 | [pop] first [dup] first sametype false =. 9 | false true sametype. 10 | '\n 'A sametype. 11 | 10 100 sametype. 12 | {1 2 3} {} sametype. 13 | "test" "" sametype. 14 | [1 2 3] [] sametype. 15 | -0.0 0.0 sametype. 16 | stdin stdout sametype. 17 | -------------------------------------------------------------------------------- /src/putch.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : putch.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef PUTCH_C 7 | #define PUTCH_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3090 putch : D N -> 11 | [IMPURE] N : numeric, writes character whose ASCII is N. 12 | */ 13 | void putch_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, PREDSUCC); 18 | node = vec_pop(env->stck); 19 | putchar(node.u.num); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/__html_manual.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __html_manual.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef __HTML_MANUAL_C 7 | #define __HTML_MANUAL_C 8 | 9 | #include "manual.h" 10 | 11 | /** 12 | Q0 IGNORE_OK 2940 __html_manual : N -> 13 | [IMPURE] Writes this manual of all Joy primitives to output file in HTML style. 14 | */ 15 | void __html_manual_(pEnv env) 16 | { 17 | make_manual(1); 18 | } 19 | #endif 20 | -------------------------------------------------------------------------------- /src/stack.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : stack.c 3 | version : 1.10 4 | date : 09/26/24 5 | */ 6 | #ifndef STACK_C 7 | #define STACK_C 8 | 9 | /** 10 | Q0 OK 1040 stack : A .. X Y Z -> .. X Y Z [Z Y X ..] 11 | Pushes the stack as a list. 12 | */ 13 | void stack_(pEnv env) 14 | { 15 | Node node; 16 | 17 | vec_copy_all(node.u.lis, env->stck); 18 | node.op = LIST_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/time.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : time.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef TIME_C 7 | #define TIME_C 8 | 9 | /** 10 | Q0 IGNORE_PUSH 1140 time : A -> I 11 | [IMPURE] Pushes the current time (in seconds since the Epoch). 12 | */ 13 | void time_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = time(0); 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/conts.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : conts.c 3 | version : 1.10 4 | date : 09/26/24 5 | */ 6 | #ifndef CONTS_C 7 | #define CONTS_C 8 | 9 | /** 10 | Q0 OK 1080 conts : A -> [[P] [Q] ..] 11 | Pushes current continuations. Buggy, do not use. 12 | */ 13 | void conts_(pEnv env) 14 | { 15 | Node node; 16 | 17 | vec_copy_all(node.u.lis, env->prog); 18 | node.op = LIST_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/fflush.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fflush.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FFLUSH_C 7 | #define FFLUSH_C 8 | 9 | /** 10 | Q0 OK 1860 fflush : N S -> S 11 | [FOREIGN] Flush stream S, forcing all buffered output to be written. 12 | */ 13 | void fflush_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, FGET); 18 | node = vec_back(env->stck); 19 | fflush(node.u.fil); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/putchars.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : putchars.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef PUTCHARS_C 7 | #define PUTCHARS_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3100 putchars : D "abc.." -> 11 | [IMPURE] Writes abc.. (without quotes) 12 | */ 13 | void putchars_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, STRTOD); 18 | node = vec_pop(env->stck); 19 | printf("%s", node.u.str); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/argc.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : argc.c 3 | version : 1.9 4 | date : 10/24/24 5 | */ 6 | #ifndef ARGC_C 7 | #define ARGC_C 8 | 9 | /** 10 | Q0 OK 3050 argc : A -> I 11 | Pushes the number of command line arguments. This is equivalent to 'argv size'. 12 | */ 13 | void argc_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = env->g_argc; 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/autoput.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : autoput.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef AUTOPUT_C 7 | #define AUTOPUT_C 8 | 9 | /** 10 | Q0 OK 1090 autoput : A -> I 11 | Pushes current value of flag for automatic output, I = 0..2. 12 | */ 13 | void autoput_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = env->autoput; 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/fold.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fold.c 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef FOLD_C 7 | #define FOLD_C 8 | 9 | /** 10 | Q1 OK 2780 fold : DDDA A V0 [P] -> V 11 | Starting with value V0, sequentially pushes members of aggregate A 12 | and combines with binary operator P to produce value V. 13 | */ 14 | void fold_(pEnv env) 15 | { 16 | PARM(3, DIP); 17 | swapd_(env); 18 | step_(env); 19 | } 20 | #endif 21 | -------------------------------------------------------------------------------- /src/popd.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : popd.c 3 | version : 1.9 4 | date : 11/20/24 5 | */ 6 | #ifndef POPD_C 7 | #define POPD_C 8 | 9 | /** 10 | Q0 OK 1260 popd : DDA Y Z -> Z 11 | As if defined by: popd == [pop] dip 12 | */ 13 | void popd_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(2, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | vec_reduce(env->stck, 1); 20 | vec_push(env->stck, node); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/unstack.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : unstack.c 3 | version : 1.10 4 | date : 09/26/24 5 | */ 6 | #ifndef UNSTACK_C 7 | #define UNSTACK_C 8 | 9 | /** 10 | Q0 OK 2000 unstack : DP [X Y ..] -> ..Y X 11 | The list [X Y ..] becomes the new stack. 12 | */ 13 | void unstack_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, HELP); 18 | node = vec_pop(env->stck); 19 | vec_copy_all(env->stck, node.u.lis); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/maxint.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : maxint.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef MAXINT_C 7 | #define MAXINT_C 8 | 9 | /** 10 | Q0 IMMEDIATE 1020 maxint : A -> maxint 11 | Pushes largest integer (platform dependent). Typically it is 32 bits. 12 | */ 13 | void maxint_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = MAXINT_; 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/set.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : set.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SET_C 7 | #define SET_C 8 | 9 | /** 10 | Q0 OK 2340 set : DA X -> B 11 | Tests whether X is a set. 12 | */ 13 | void set_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == SET_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/undeferror.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : undeferror.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef UNDEFERROR_C 7 | #define UNDEFERROR_C 8 | 9 | /** 10 | Q0 OK 1100 undeferror : A -> I 11 | Pushes current value of undefined-is-error flag. 12 | */ 13 | void undeferror_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = env->undeferror; 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /test1/m23.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : m23.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | MODULE m2 7 | PRIVATE 8 | a == "A"; 9 | b == "B"; 10 | PUBLIC 11 | ab == a b concat; 12 | ba == b a concat; 13 | MODULE m1 14 | PRIVATE 15 | a == "a"; 16 | b == "b"; 17 | PUBLIC 18 | ab == a b concat; 19 | ba == b a concat; 20 | PRIVATE; (* should be END *) 21 | test == ab ba concat; 22 | END 23 | 24 | m2.test. 25 | -------------------------------------------------------------------------------- /test2/concat.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : concat.joy 3 | version : 1.7 4 | date : 08/29/24 5 | *) 6 | [1 2 3] [4 5 6] concat [1 2 3 4 5 6] equal. 7 | "test" "uftu" concat "testuftu" =. 8 | {1 2 3} {4 5 6} concat {1 2 3 4 5 6} =. 9 | [] [1 2 3] concat [1 2 3] equal. 10 | [1 2 3] [] concat [1 2 3] equal. 11 | 12 | [1 2 3] dup [4 5 6] concat swap [7 8 9] concat stack 13 | [[1 2 3 7 8 9] [1 2 3 4 5 6]] equal. 14 | 15 | (* error *) 16 | # 10 10 concat. 17 | -------------------------------------------------------------------------------- /src/app12.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : app12.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef APP12_C 7 | #define APP12_C 8 | 9 | /** 10 | Q1 OK 2460 app12 : DDDDAA X Y1 Y2 [P] -> R1 R2 11 | Executes P twice, with Y1 and Y2, returns R1 and R2. 12 | */ 13 | void app12_(pEnv env) 14 | { 15 | /* X Y Z [P] app12 */ 16 | PARM(4, DIP); 17 | code(env, pop_); 18 | code(env, rolldown_); 19 | unary2_(env); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/ord.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ord.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ORD_C 7 | #define ORD_C 8 | 9 | /** 10 | Q0 OK 1460 ord : DA C -> I 11 | Integer I is the Ascii value of character C (or logical or integer). 12 | */ 13 | void ord_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, PREDSUCC); 18 | node = vec_pop(env->stck); 19 | node.op = INTEGER_; 20 | vec_push(env->stck, node); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /test2/small.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : small.joy 3 | version : 1.6 4 | date : 08/29/24 5 | *) 6 | [] small. 7 | [1] small. 8 | [1 2] small false =. 9 | "" small. 10 | "t" small. 11 | "test" small false =. 12 | {} small. 13 | {1} small. 14 | {1 2} small false =. 15 | 0 small. 16 | 1 small. 17 | 2 small false =. 18 | 19 | (* error *) 20 | # [pop] first small =. 21 | 22 | # 0.0 small =. 23 | # 1.0 small =. 24 | 25 | # stdin small =. 26 | # stdout small =. 27 | -------------------------------------------------------------------------------- /src/__symtabmax.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __symtabmax.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef __SYMTABMAX_C 7 | #define __SYMTABMAX_C 8 | 9 | /** 10 | Q0 OK 1050 __symtabmax : A -> I 11 | Pushes value of maximum size of the symbol table. 12 | */ 13 | void __symtabmax_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = vec_max(env->symtab); 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/chr.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : chr.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef CHR_C 7 | #define CHR_C 8 | 9 | /** 10 | Q0 OK 1470 chr : DA I -> C 11 | C is the character whose Ascii value is integer I (or logical or character). 12 | */ 13 | void chr_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, PREDSUCC); 18 | node = vec_pop(env->stck); 19 | node.op = CHAR_; 20 | vec_push(env->stck, node); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/list.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : list.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LIST_C 7 | #define LIST_C 8 | 9 | /** 10 | Q0 OK 2360 list : DA X -> B 11 | Tests whether X is a list. 12 | */ 13 | void list_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == LIST_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /test2/cond.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : cond.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | DEFINE test == [[[dup 1 =] "one"] 7 | [[dup 2 =] "two"] 8 | ["other"]] cond. 9 | 10 | 1 test stack ["one" 1] equal. 11 | 12 | [] unstack. 13 | 2 test stack ["two" 2] equal. 14 | [] unstack. 15 | 3 test stack ["other" 3] equal. 16 | 17 | DEFINE test == [["other"]] cond. 18 | 19 | 1 test "other" =. 20 | 21 | DEFINE test == [[]] cond. 22 | 23 | 1 test 1 =. 24 | -------------------------------------------------------------------------------- /src/__memoryindex.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __memoryindex.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef __MEMORYINDEX_C 7 | #define __MEMORYINDEX_C 8 | 9 | /** 10 | Q0 IGNORE_PUSH 3060 __memoryindex : A -> I 11 | Pushes current value of memory. 12 | */ 13 | void __memoryindex_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = GC_get_memory_use(); 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/__symtabindex.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __symtabindex.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef __SYMTABINDEX_C 7 | #define __SYMTABINDEX_C 8 | 9 | /** 10 | Q0 OK 1060 __symtabindex : A -> I 11 | Pushes current size of the symbol table. 12 | */ 13 | void __symtabindex_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = vec_size(env->symtab); 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/char.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : char.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef CHAR_C 7 | #define CHAR_C 8 | 9 | /** 10 | Q0 OK 2320 char : DA X -> B 11 | Tests whether X is a character. 12 | */ 13 | void char_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == CHAR_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/dip.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : dip.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef DIP_C 7 | #define DIP_C 8 | 9 | /** 10 | Q1 OK 2430 dip : DDPA X [P] -> ... X 11 | Saves X, executes P, pushes X back. 12 | */ 13 | void dip_(pEnv env) 14 | { 15 | Node list, node; 16 | 17 | PARM(2, DIP); 18 | list = vec_pop(env->stck); 19 | node = vec_pop(env->stck); 20 | prime(env, node); 21 | prog(env, list.u.lis); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/leaf.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : leaf.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LEAF_C 7 | #define LEAF_C 8 | 9 | /** 10 | Q0 OK 2370 leaf : DA X -> B 11 | Tests whether X is not a list. 12 | */ 13 | void leaf_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op != LIST_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/over.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : over.c 3 | version : 1.13 4 | date : 09/17/24 5 | */ 6 | #ifndef OVER_C 7 | #define OVER_C 8 | 9 | /** 10 | Q0 OK 3180 over : A X Y -> X Y X 11 | [EXT] Pushes an extra copy of the second item X on top of the stack. 12 | */ 13 | void over_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(2, ANYTYPE); 18 | node = vec_at(env->stck, vec_size(env->stck) - 2); 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /test2/filter.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : filter.joy 3 | version : 1.8 4 | date : 08/29/24 5 | *) 6 | [1 2 3 4 5 6 7 8 9 10] [5 <] filter [1 2 3 4] equal. 7 | "test" ['t <] filter "es" =. 8 | {1 2 3} [2 <] filter {1} =. 9 | 10 | [] [2 <] filter [] equal. 11 | "" ['t <] filter "" =. 12 | {} [2 <] filter {} =. 13 | 14 | [1 2 3] [] filter [1 2 3] equal. 15 | "test" [] filter "test" equal. 16 | {1 2 3} [] filter {1 2 3} equal. 17 | 18 | (* error *) 19 | # 'A [] filter. 20 | -------------------------------------------------------------------------------- /src/__latex_manual.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __latex_manual.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef __LATEX_MANUAL_C 7 | #define __LATEX_MANUAL_C 8 | 9 | #include "manual.h" 10 | 11 | /** 12 | Q0 IGNORE_OK 2950 __latex_manual : N -> 13 | [IMPURE] Writes this manual of all Joy primitives to output file in Latex style 14 | but without the head and tail. 15 | */ 16 | void __latex_manual_(pEnv env) 17 | { 18 | make_manual(2); 19 | } 20 | #endif 21 | -------------------------------------------------------------------------------- /src/file.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : file.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FILE_C 7 | #define FILE_C 8 | 9 | /** 10 | Q0 OK 2400 file : DA F -> B 11 | [FOREIGN] Tests whether F is a file. 12 | */ 13 | void file_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == FILE_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/float.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : float.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef FLOAT_C 7 | #define FLOAT_C 8 | 9 | /** 10 | Q0 OK 2390 float : DA R -> B 11 | Tests whether R is a float. 12 | */ 13 | void float_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == FLOAT_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/enconcat.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : enconcat.c 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef ENCONCAT_C 7 | #define ENCONCAT_C 8 | 9 | /** 10 | Q0 OK 2160 enconcat : DDDA X S T -> U 11 | Sequence U is the concatenation of sequences S and T 12 | with X inserted between S and T (== swapd cons concat). 13 | */ 14 | void enconcat_(pEnv env) 15 | { 16 | PARM(3, CONCAT); 17 | swapd_(env); 18 | cons_(env); 19 | concat_(env); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/string.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : string.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef STRING_C 7 | #define STRING_C 8 | 9 | /** 10 | Q0 OK 2350 string : DA X -> B 11 | Tests whether X is a string. 12 | */ 13 | void string_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == STRING_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/__memorymax.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __memorymax.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef __MEMORYMAX_C 7 | #define __MEMORYMAX_C 8 | 9 | /** 10 | Q0 IGNORE_PUSH 1160 __memorymax : A -> I 11 | Pushes value of total size of memory. 12 | */ 13 | void __memorymax_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = GC_get_memory_use() + GC_get_free_bytes(); 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/cos.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : cos.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef COS_C 7 | #define COS_C 8 | 9 | /** 10 | Q0 OK 1540 cos : DA F -> G 11 | G is the cosine of F. 12 | */ 13 | void cos_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = cos(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/feof.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : feof.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FEOF_C 7 | #define FEOF_C 8 | 9 | /** 10 | Q0 OK 1840 feof : A S -> S B 11 | [FOREIGN] B is the end-of-file status of stream S. 12 | */ 13 | void feof_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, FGET); 18 | node = vec_back(env->stck); 19 | node.u.num = feof(node.u.fil); 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/integer.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : integer.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef INTEGER_C 7 | #define INTEGER_C 8 | 9 | /** 10 | Q0 OK 2310 integer : DA X -> B 11 | Tests whether X is an integer. 12 | */ 13 | void integer_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == INTEGER_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/logical.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : logical.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LOGICAL_C 7 | #define LOGICAL_C 8 | 9 | /** 10 | Q0 OK 2330 logical : DA X -> B 11 | Tests whether X is a logical. 12 | */ 13 | void logical_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == BOOLEAN_; 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/sin.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : sin.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SIN_C 7 | #define SIN_C 8 | 9 | /** 10 | Q0 OK 1640 sin : DA F -> G 11 | G is the sine of F. 12 | */ 13 | void sin_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = sin(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/strtod.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : strtod.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef STRTOD_C 7 | #define STRTOD_C 8 | 9 | /** 10 | Q0 OK 1750 strtod : DA S -> R 11 | String S is converted to the float R. 12 | */ 13 | void strtod_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, STRTOD); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = strtod(node.u.str, 0); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/tan.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : tan.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef TAN_C 7 | #define TAN_C 8 | 9 | /** 10 | Q0 OK 1670 tan : DA F -> G 11 | G is the tangent of F. 12 | */ 13 | void tan_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = tan(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /lib/quad.joy: -------------------------------------------------------------------------------- 1 | DEFINE 2 | quadratic-2 == # a b c => [root1 root2] 3 | [ [ [ pop pop 2 * ] # divisor 4 | [ pop 0 swap - ] # minusb 5 | [ swap dup * rollup * 4 * - sqrt] ] # radical 6 | [i] map ] 7 | ternary i 8 | [ [ [ + swap / ] # root1 9 | [ - swap / ] ] # root2 10 | [i] map ] 11 | ternary. 12 | 13 | -------------------------------------------------------------------------------- /src/clock.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : clock.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef CLOCK_C 7 | #define CLOCK_C 8 | 9 | /** 10 | Q0 IGNORE_PUSH 1130 clock : A -> I 11 | [IMPURE] Pushes the integer value of current CPU usage in milliseconds. 12 | */ 13 | void clock_(pEnv env) 14 | { 15 | Node node; 16 | 17 | node.u.num = ((clock() - env->startclock) * 1000) / CLOCKS_PER_SEC; 18 | node.op = INTEGER_; 19 | vec_push(env->stck, node); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/ferror.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ferror.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FERROR_C 7 | #define FERROR_C 8 | 9 | /** 10 | Q0 OK 1850 ferror : A S -> S B 11 | [FOREIGN] B is the error status of stream S. 12 | */ 13 | void ferror_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, FGET); 18 | node = vec_back(env->stck); 19 | node.u.num = ferror(node.u.fil); 20 | node.op = BOOLEAN_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/ftell.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ftell.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef FTELL_C 7 | #define FTELL_C 8 | 9 | /** 10 | Q0 OK 1990 ftell : A S -> S I 11 | [FOREIGN] I is the current position of stream S. 12 | */ 13 | void ftell_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, FGET); 18 | node = vec_back(env->stck); 19 | node.u.num = ftell(node.u.fil); 20 | node.op = INTEGER_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/trunc.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : trunc.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef TRUNC_C 7 | #define TRUNC_C 8 | 9 | /** 10 | Q0 OK 1690 trunc : DA F -> I 11 | I is an integer equal to the float F truncated toward zero. 12 | */ 13 | void trunc_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.u.dbl; 20 | node.op = INTEGER_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/acos.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : acos.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ACOS_C 7 | #define ACOS_C 8 | 9 | /** 10 | Q0 OK 1490 acos : DA F -> G 11 | G is the arc cosine of F. 12 | */ 13 | void acos_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = acos(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/asin.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : asin.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ASIN_C 7 | #define ASIN_C 8 | 9 | /** 10 | Q0 OK 1500 asin : DA F -> G 11 | G is the arc sine of F. 12 | */ 13 | void asin_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = asin(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/fputch.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fputch.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FPUTCH_C 7 | #define FPUTCH_C 8 | 9 | /** 10 | Q0 OK 1950 fputch : A S C -> S 11 | [FOREIGN] The character C is written to the current position of stream S. 12 | */ 13 | void fputch_(pEnv env) 14 | { 15 | Node elem, node; 16 | 17 | PARM(2, FREAD); 18 | elem = vec_pop(env->stck); 19 | node = vec_back(env->stck); 20 | putc(elem.u.num, node.u.fil); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/genrec.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : genrec.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef GENREC_C 7 | #define GENREC_C 8 | 9 | /** 10 | Q4 OK 2740 genrec : DDDDDA [B] [T] [R1] [R2] -> ... 11 | Executes B, if that yields true, executes T. 12 | Else executes R1 and then [[[B] [T] [R1] R2] genrec] R2. 13 | */ 14 | void genrec_(pEnv env) 15 | { 16 | PARM(4, LINREC); 17 | cons_(env); 18 | cons_(env); 19 | cons_(env); 20 | genrecaux_(env); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/log.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : log.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LOG_C 7 | #define LOG_C 8 | 9 | /** 10 | Q0 OK 1600 log : DA F -> G 11 | G is the natural logarithm of F. 12 | */ 13 | void log_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = log(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/setecho.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : setecho.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef SETECHO_C 7 | #define SETECHO_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3000 setecho : D I -> 11 | [IMPURE] Sets value of echo flag for listing. 12 | I = 0: no echo, 1: echo, 2: with tab, 3: and linenumber. 13 | */ 14 | void setecho_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, PREDSUCC); 19 | node = vec_pop(env->stck); 20 | env->echoflag = node.u.num; 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/spush.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : spush.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef SPUSH_C 7 | #define SPUSH_C 8 | 9 | /** 10 | Q0 OK 3360 #spush : A -> 11 | Pop the location of an element on the code stack. 12 | Read that element and push it on the data stack. 13 | */ 14 | void spush_(pEnv env) 15 | { 16 | Node jump, node; 17 | 18 | jump = vec_pop(env->prog); 19 | node = vec_at(env->prog, jump.u.num); 20 | vec_push(env->stck, node); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/times.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : times.c 3 | version : 1.12 4 | date : 11/12/24 5 | */ 6 | #ifndef TIMES_C 7 | #define TIMES_C 8 | 9 | /** 10 | Q1 OK 2800 times : DDA N [P] -> ... 11 | N times executes P. 12 | */ 13 | void times_(pEnv env) 14 | { 15 | int64_t i; 16 | Node list, node; 17 | 18 | PARM(2, TIMES); 19 | list = vec_pop(env->stck); 20 | node = vec_pop(env->stck); 21 | for (i = 0; i < node.u.num; i++) 22 | prog(env, list.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /test2/some.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : some.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | [1 2 3] [2 <] some. 7 | [1 2 3] [4 <] some. 8 | [1 2 3] [1 <] some false =. 9 | {1 2 3} [2 <] some. 10 | {1 2 3} [4 <] some. 11 | {1 2 3} [1 <] some false =. 12 | "test" ['t <] some. 13 | "test" ['u <] some. 14 | "test" ['e <] some false =. 15 | 16 | [] [2 <] some false =. 17 | "" ['t <] some false =. 18 | {} [2 <] some false =. 19 | 20 | [1 2 3] [] some. 21 | "test" [] some. 22 | {1 2 3} [] some. 23 | -------------------------------------------------------------------------------- /src/atan.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : atan.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ATAN_C 7 | #define ATAN_C 8 | 9 | /** 10 | Q0 OK 1510 atan : DA F -> G 11 | G is the arc tangent of F. 12 | */ 13 | void atan_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = atan(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/ceil.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ceil.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef CEIL_C 7 | #define CEIL_C 8 | 9 | /** 10 | Q0 OK 1530 ceil : DA F -> G 11 | G is the float ceiling of F. 12 | */ 13 | void ceil_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = ceil(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/fgetch.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fgetch.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FGETCH_C 7 | #define FGETCH_C 8 | 9 | /** 10 | Q0 OK 1870 fgetch : A S -> S C 11 | [FOREIGN] C is the next available character from stream S. 12 | */ 13 | void fgetch_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, FGET); 18 | node = vec_back(env->stck); 19 | node.u.num = getc(node.u.fil); 20 | node.op = CHAR_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/floor.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : floor.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef FLOOR_C 7 | #define FLOOR_C 8 | 9 | /** 10 | Q0 OK 1570 floor : DA F -> G 11 | G is the floor of F. 12 | */ 13 | void floor_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = floor(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/sinh.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : sinh.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SINH_C 7 | #define SINH_C 8 | 9 | /** 10 | Q0 OK 1650 sinh : DA F -> G 11 | G is the hyperbolic sine of F. 12 | */ 13 | void sinh_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = sinh(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/sqrt.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : sqrt.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SQRT_C 7 | #define SQRT_C 8 | 9 | /** 10 | Q0 OK 1660 sqrt : DA F -> G 11 | G is the square root of F. 12 | */ 13 | void sqrt_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = sqrt(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/swap.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : swap.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SWAP_C 7 | #define SWAP_C 8 | 9 | /** 10 | Q0 OK 1220 swap : DDAA X Y -> Y X 11 | Interchanges X and Y on top of the stack. 12 | */ 13 | void swap_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, ANYTYPE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | vec_push(env->stck, second); 21 | vec_push(env->stck, first); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/cosh.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : cosh.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef COSH_C 7 | #define COSH_C 8 | 9 | /** 10 | Q0 OK 1550 cosh : DA F -> G 11 | G is the hyperbolic cosine of F. 12 | */ 13 | void cosh_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = cosh(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/tanh.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : tanh.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef TANH_C 7 | #define TANH_C 8 | 9 | /** 10 | Q0 OK 1680 tanh : DA F -> G 11 | G is the hyperbolic tangent of F. 12 | */ 13 | void tanh_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = tanh(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /test2/take.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : take.joy 3 | version : 1.11 4 | date : 09/19/24 5 | *) 6 | [1 2 3] 2 take [1 2] equal. 7 | "test" 2 take "te" =. 8 | {1 2 3} 2 take {1 2} =. 9 | 10 | (* 1 is not allowed in character strings *) 11 | "te\002st" 10 take "te\002st" =. 12 | 13 | (* 1 is allowed as character constant *) 14 | '\001 1 =. 15 | 16 | (* test overtake *) 17 | [1 2 3] 10 take [1 2 3] equal. 18 | "test" 10 take "test" =. 19 | {1 2 3} 10 take {1 2 3} =. 20 | 21 | (* error *) 22 | # 10 10 take. 23 | -------------------------------------------------------------------------------- /src/log10.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : log10.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LOG10_C 7 | #define LOG10_C 8 | 9 | /** 10 | Q0 OK 1610 log10 : DA F -> G 11 | G is the common logarithm of F. 12 | */ 13 | void log10_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = log10(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/exp.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : exp.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef EXP_C 7 | #define EXP_C 8 | 9 | /** 10 | Q0 OK 1560 exp : DA F -> G 11 | G is e (2.718281828...) raised to the Fth power. 12 | */ 13 | void exp_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = exp(node.op == FLOAT_ ? node.u.dbl : (double)node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/round.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : round.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef ROUND_C 7 | #define ROUND_C 8 | 9 | /** 10 | Q0 OK 3200 round : DA F -> G 11 | [EXT] G is F rounded to the nearest integer. 12 | */ 13 | void round_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | node.u.dbl = round(node.op == FLOAT_ ? node.u.dbl : node.u.num); 20 | node.op = FLOAT_; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/setsize.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : setsize.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef SETSIZE_C 7 | #define SETSIZE_C 8 | 9 | /** 10 | Q0 OK 1030 setsize : A -> setsize 11 | Pushes the maximum number of elements in a set (platform dependent). 12 | Typically it is 32, and set members are in the range 0..31. 13 | */ 14 | void setsize_(pEnv env) 15 | { 16 | Node node; 17 | 18 | node.u.num = SETSIZE; 19 | node.op = INTEGER_; 20 | vec_push(env->stck, node); 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/treegenrec.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : treegenrec.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef TREEGENREC_C 7 | #define TREEGENREC_C 8 | 9 | /** 10 | Q3 OK 2890 treegenrec : DDDDA T [O1] [O2] [C] -> ... 11 | T is a tree. If T is a leaf, executes O1. 12 | Else executes O2 and then [[[O1] [O2] C] treegenrec] C. 13 | */ 14 | void treegenrec_(pEnv env) 15 | { /* T [O1] [O2] [C] */ 16 | PARM(4, IFTE); 17 | cons_(env); 18 | cons_(env); 19 | treegenrecaux_(env); 20 | } 21 | #endif 22 | -------------------------------------------------------------------------------- /src/__settracegc.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __settracegc.c 3 | version : 1.13 4 | date : 10/11/24 5 | */ 6 | #ifndef __SETTRACEGC_C 7 | #define __SETTRACEGC_C 8 | 9 | /** 10 | Q0 OK 2970 __settracegc : D I -> 11 | [IMPURE] Sets value of flag for tracing garbage collection to I (= 0..6). 12 | */ 13 | void __settracegc_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, PREDSUCC); 18 | node = vec_pop(env->stck); 19 | if (!node.u.num) 20 | env->ignore = 0; /* disable ignore */ 21 | } 22 | #endif 23 | -------------------------------------------------------------------------------- /src/getenv.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : getenv.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef GETENV_C 7 | #define GETENV_C 8 | 9 | /** 10 | Q0 OK 3030 getenv : DA "variable" -> "value" 11 | Retrieves the value of the environment variable "variable". 12 | */ 13 | void getenv_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, STRTOD); 18 | node = vec_pop(env->stck); 19 | if ((node.u.str = getenv(node.u.str)) == 0) 20 | node.u.str = ""; 21 | vec_push(env->stck, node); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/neg.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : neg.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef NEG_C 7 | #define NEG_C 8 | 9 | /** 10 | Q0 OK 1450 neg : DA I -> J 11 | Integer J is the negative of integer I. Also supports float. 12 | */ 13 | void neg_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, UFLOAT); 18 | node = vec_pop(env->stck); 19 | if (node.op == FLOAT_) 20 | node.u.dbl = -node.u.dbl; 21 | else 22 | node.u.num = -node.u.num; 23 | vec_push(env->stck, node); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/user.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : user.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef USER_C 7 | #define USER_C 8 | 9 | /** 10 | Q0 OK 2380 user : DA X -> B 11 | Tests whether X is a user-defined symbol. 12 | */ 13 | void user_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | node.u.num = node.op == USR_ || 20 | node.op == USR_STRING_ || node.op == USR_LIST_; 21 | node.op = BOOLEAN_; 22 | vec_push(env->stck, node); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/dupd.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : dupd.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef DUPD_C 7 | #define DUPD_C 8 | 9 | /** 10 | Q0 OK 1270 dupd : DDAAA Y Z -> Y Y Z 11 | As if defined by: dupd == [dup] dip 12 | */ 13 | void dupd_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, ANYTYPE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | vec_push(env->stck, first); 21 | vec_push(env->stck, first); 22 | vec_push(env->stck, second); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /test1/m22.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : m22.joy 3 | version : 1.2 4 | date : 04/11/24 5 | *) 6 | 7 | (* 8 | Module with PRIVATE section and forward calling. 9 | *) 10 | MODULE m1 11 | PRIVATE 12 | b == a "b" concat; 13 | a == "a"; 14 | PUBLIC 15 | test == b; 16 | END 17 | 18 | # should print "ab". 19 | m1.test. 20 | 21 | (* 22 | Module with PUBLIC section and forward calling. 23 | *) 24 | MODULE m2 25 | PUBLIC 26 | b == a "b" concat; 27 | a == "a"; 28 | END 29 | 30 | # should print "ab". 31 | m2.b. 32 | -------------------------------------------------------------------------------- /test1/m25.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : m25.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | MODULE m2 7 | PRIVATE 8 | a == "A"; 9 | b == "B"; 10 | PUBLIC 11 | ab == a b concat; 12 | ba == b a concat; 13 | MODULE m1 14 | PRIVATE 15 | a == "a"; 16 | b == "b"; 17 | PUBLIC 18 | ab == a b concat; 19 | ba == b a concat; 20 | END; 21 | test1 == m1.ab m1.ba concat; 22 | test2 == ab ba concat; 23 | END 24 | 25 | m2.test1. 26 | m2.test2. 27 | 28 | (* m1 should not be accessable *) 29 | m1.ab. 30 | -------------------------------------------------------------------------------- /src/casting.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : casting.c 3 | version : 1.12 4 | date : 09/17/24 5 | */ 6 | #ifndef CASTING_C 7 | #define CASTING_C 8 | 9 | /** 10 | Q0 OK 3150 casting : DDA X Y -> Z 11 | [EXT] Z takes the value from X and uses the value from Y as its type. 12 | */ 13 | void casting_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, ANYTYPE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | first.op = second.u.num; 21 | vec_push(env->stck, first); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/setautoput.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : setautoput.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef SETAUTOPUT_C 7 | #define SETAUTOPUT_C 8 | 9 | /** 10 | Q0 IGNORE_POP 2980 setautoput : D I -> 11 | [IMPURE] Sets value of flag for automatic put to I (if I = 0, none; 12 | if I = 1, put; if I = 2, stack). 13 | */ 14 | void setautoput_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, PREDSUCC); 19 | node = vec_pop(env->stck); 20 | if (!env->autoput_set) 21 | env->autoput = node.u.num; 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/body.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : body.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef BODY_C 7 | #define BODY_C 8 | 9 | /** 10 | Q0 OK 2190 body : DA U -> [P] 11 | Quotation [P] is the body of user-defined symbol U. 12 | */ 13 | void body_(pEnv env) 14 | { 15 | Node node; 16 | Entry ent; 17 | 18 | PARM(1, BODY); 19 | node = vec_pop(env->stck); 20 | ent = vec_at(env->symtab, node.u.ent); 21 | node.u.lis = ent.u.body; 22 | node.op = LIST_; 23 | vec_push(env->stck, node); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/include.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : include.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef INCLUDE_C 7 | #define INCLUDE_C 8 | 9 | /** 10 | Q0 OK 3110 include : D "filnam.ext" -> 11 | Transfers input to file whose name is "filnam.ext". 12 | On end-of-file returns to previous input file. 13 | */ 14 | void include_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, STRTOD); 19 | node = vec_pop(env->stck); 20 | if (include(env, node.u.str)) 21 | execerror("valid file name", "include"); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/put.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : put.c 3 | version : 1.12 4 | date : 09/17/24 5 | */ 6 | #ifndef PUT_C 7 | #define PUT_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3080 put : D X -> 11 | [IMPURE] Writes X to output, pops X off stack. 12 | */ 13 | void put_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | if (node.op == LIST_) { 20 | putchar('['); 21 | writeterm(env, node.u.lis, stdout); 22 | putchar(']'); 23 | } else 24 | writefactor(env, node, stdout); 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /src/setundeferror.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : setundeferror.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef SETUNDEFERROR_C 7 | #define SETUNDEFERROR_C 8 | 9 | /** 10 | Q0 IGNORE_POP 2990 setundeferror : D I -> 11 | [IMPURE] Sets flag that controls behavior of undefined functions 12 | (0 = no error, 1 = error). 13 | */ 14 | void setundeferror_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, PREDSUCC); 19 | node = vec_pop(env->stck); 20 | if (!env->undeferror_set) 21 | env->undeferror = node.u.num; 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/system.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : system.c 3 | version : 1.12 4 | date : 09/23/24 5 | */ 6 | #ifndef SYSTEM_C 7 | #define SYSTEM_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3020 system : D "command" -> 11 | [IMPURE] Escapes to shell, executes string "command". 12 | The string may cause execution of another program. 13 | When that has finished, the process returns to Joy. 14 | */ 15 | void system_(pEnv env) 16 | { 17 | Node node; 18 | 19 | PARM(1, STRTOD); 20 | node = vec_pop(env->stck); 21 | (void)system(node.u.str); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /lib/tutinp.joy: -------------------------------------------------------------------------------- 1 | (* FILE: joytut.inp *) 2 | 3 | "joytut.joy" include. 4 | 1 setecho. 5 | 6 | (* input that might have come from a terminal *) 7 | 8 | joytut quit. 9 | hahaha 10 | 1234 11 | 42 12 | 36 13 | 5 14 | 7 15 | [2 4 7] 16 | [ 8 9 3 ] 17 | [ [5 3] 5 3] 18 | [ [5 3] 5 3] 19 | [73] 20 | 21 | [ 9 4 16] 22 | [ 10 + ] 23 | [5 3 7] 24 | [ 20 <] 25 | 26 | 15 27 | -8 28 | [ 0 =] 29 | [ succ ] 30 | [ factorial *] 31 | [ dup pred ] 32 | [ * ] 33 | 34 | 2 35 | 36 | [6 4 8] 37 | [ 10 + ] 38 | [5 3 7] 39 | [ 20 <] 40 | 41 | 999 42 | -------------------------------------------------------------------------------- /src/choice.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : choice.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef CHOICE_C 7 | #define CHOICE_C 8 | 9 | /** 10 | Q0 OK 1330 choice : DDDA B T F -> X 11 | If B is true, then X = T else X = F. 12 | */ 13 | void choice_(pEnv env) 14 | { 15 | Node first, second, third; 16 | 17 | PARM(3, ANYTYPE); 18 | third = vec_pop(env->stck); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | first = first.u.num ? second : third; 22 | vec_push(env->stck, first); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/ifset.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ifset.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFSET_C 7 | #define IFSET_C 8 | 9 | /** 10 | Q2 OK 2640 ifset : DDDP X [T] [E] -> ... 11 | If X is a set, executes T else executes E. 12 | */ 13 | void ifset_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == SET_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/cpush.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : cpush.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef CPUSH_C 7 | #define CPUSH_C 8 | 9 | /** 10 | Q0 OK 3350 #cpush : D -> 11 | Pop the location of an element from the code stack. 12 | Pop an element from the data stack and store it at the given location. 13 | */ 14 | void cpush_(pEnv env) 15 | { 16 | Node jump, node; 17 | 18 | PARM(1, ANYTYPE); 19 | jump = vec_pop(env->prog); 20 | node = vec_pop(env->stck); 21 | vec_at(env->prog, jump.u.num) = node; /* write node */ 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/branch.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : branch.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef BRANCH_C 7 | #define BRANCH_C 8 | 9 | /** 10 | Q2 OK 2590 branch : DDDP B [T] [F] -> ... 11 | If B is true, then executes T else executes F. 12 | */ 13 | void branch_(pEnv env) 14 | { 15 | Node first, second, third; 16 | 17 | PARM(3, WHILE); 18 | third = vec_pop(env->stck); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | first = first.u.num ? second : third; 22 | prog(env, first.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/iflist.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : iflist.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFLIST_C 7 | #define IFLIST_C 8 | 9 | /** 10 | Q2 OK 2660 iflist : DDDP X [T] [E] -> ... 11 | If X is a list, executes T else executes E. 12 | */ 13 | void iflist_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == LIST_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/typeof.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : typeof.c 3 | version : 1.17 4 | date : 09/17/24 5 | */ 6 | #ifndef TYPEOF_C 7 | #define TYPEOF_C 8 | 9 | /** 10 | Q0 OK 3220 typeof : DA X -> I 11 | [EXT] Replace X by its type. 12 | */ 13 | void typeof_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, ANYTYPE); 18 | node = vec_pop(env->stck); 19 | if (node.op == USR_STRING_ || node.op == USR_LIST_) 20 | node.op = USR_; /* LCOV_EXCL_LINE */ 21 | node.u.num = node.op; 22 | node.op = INTEGER_; 23 | vec_push(env->stck, node); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /test2/not.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : not.joy 3 | version : 1.7 4 | date : 08/29/24 5 | *) 6 | true not false =. 7 | false not. 8 | {} not {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63} =. 9 | {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 10 | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 11 | 57 58 59 60 61 62 63} not {} =. 12 | 13 | (* error *) 14 | # 10.0 not. 15 | -------------------------------------------------------------------------------- /test2/opcase.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : opcase.joy 3 | version : 1.5 4 | date : 03/21/24 5 | *) 6 | DEFINE test == [['A "ischar"] 7 | [dup "isdup"] 8 | [pop "ispop"] 9 | [10 "isinteger"] 10 | ["isother"]] opcase i. 11 | 12 | 'A test "ischar" =. 13 | 10 test "isinteger" =. 14 | 1.1 test "isother" =. 15 | [test] first test "isother" =. 16 | [pop] first test "ispop" =. 17 | 18 | DEFINE test == [['A "ischar" "ischar"] 19 | [pop "ispop" "ispop"] 20 | [10 "isinteger" "isinteger"] 21 | ["isother" "isother"]] opcase i. 22 | 23 | 10 test "isinteger" =. 24 | -------------------------------------------------------------------------------- /src/ifchar.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ifchar.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFCHAR_C 7 | #define IFCHAR_C 8 | 9 | /** 10 | Q2 OK 2620 ifchar : DDDP X [T] [E] -> ... 11 | If X is a character, executes T else executes E. 12 | */ 13 | void ifchar_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == CHAR_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/iffloat.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : iffloat.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFFLOAT_C 7 | #define IFFLOAT_C 8 | 9 | /** 10 | Q2 OK 2670 iffloat : DDDP X [T] [E] -> ... 11 | If X is a float, executes T else executes E. 12 | */ 13 | void iffloat_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == FLOAT_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/iffile.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : iffile.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef IFFILE_C 7 | #define IFFILE_C 8 | 9 | /** 10 | Q2 OK 2680 iffile : DDDP X [T] [E] -> ... 11 | [FOREIGN] If X is a file, executes T else executes E. 12 | */ 13 | void iffile_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == FILE_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/ldexp.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ldexp.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LDEXP_C 7 | #define LDEXP_C 8 | 9 | /** 10 | Q0 OK 1590 ldexp : DDA F I -> G 11 | G is F times 2 to the Ith power. 12 | */ 13 | void ldexp_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, LDEXP); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | first.u.dbl = ldexp(first.op == FLOAT_ ? first.u.dbl : first.u.num, 21 | second.u.num); 22 | first.op = FLOAT_; 23 | vec_push(env->stck, first); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/rotate.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rotate.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ROTATE_C 7 | #define ROTATE_C 8 | 9 | /** 10 | Q0 OK 1250 rotate : DDDAAA X Y Z -> Z Y X 11 | Interchanges X and Z. 12 | */ 13 | void rotate_(pEnv env) 14 | { 15 | Node first, second, third; 16 | 17 | PARM(3, ANYTYPE); 18 | third = vec_pop(env->stck); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | vec_push(env->stck, third); 22 | vec_push(env->stck, second); 23 | vec_push(env->stck, first); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /test1/m24.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : m24.joy 3 | version : 1.1 4 | date : 03/21/24 5 | *) 6 | MODULE m1 7 | MODULE m2 8 | MODULE m3 9 | MODULE m4 10 | MODULE m5 11 | MODULE m6 12 | MODULE m7 13 | MODULE m8 14 | MODULE m9 15 | MODULE m10 16 | MODULE m11 17 | END; 18 | END; 19 | END; 20 | END; 21 | END; 22 | END; 23 | END; 24 | END; 25 | END; 26 | END; 27 | END. 28 | -------------------------------------------------------------------------------- /src/fremove.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fremove.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FREMOVE_C 7 | #define FREMOVE_C 8 | 9 | /** 10 | Q0 OK 1920 fremove : DA P -> B 11 | [FOREIGN] The file system object with pathname P is removed from the file 12 | system. B is a boolean indicating success or failure. 13 | */ 14 | void fremove_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, STRTOD); 19 | node = vec_pop(env->stck); 20 | node.u.num = !remove(node.u.str); 21 | node.op = BOOLEAN_; 22 | vec_push(env->stck, node); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/ifstring.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ifstring.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFSTRING_C 7 | #define IFSTRING_C 8 | 9 | /** 10 | Q2 OK 2650 ifstring : DDDP X [T] [E] -> ... 11 | If X is a string, executes T else executes E. 12 | */ 13 | void ifstring_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == STRING_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/pfalse.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : pfalse.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef PFALSE_C 7 | #define PFALSE_C 8 | 9 | /** 10 | Q0 OK 3370 #pfalse : D -> 11 | Pop the jump location from the program stack. Pop the condition from the data 12 | stack. If the condition is false, jump to that location. 13 | */ 14 | void pfalse_(pEnv env) 15 | { 16 | Node test, jump; 17 | 18 | PARM(1, ANYTYPE); 19 | test = vec_pop(env->stck); 20 | jump = vec_pop(env->prog); 21 | if (!test.u.num) 22 | vec_setsize(env->prog, jump.u.num); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/strue.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : strue.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef STRUE_C 7 | #define STRUE_C 8 | 9 | /** 10 | Q0 OK 3400 #strue : N -> 11 | Pop the jump location from the program stack. If the top of the data stack 12 | is true, jump to that location. 13 | */ 14 | void strue_(pEnv env) 15 | { 16 | Node test, jump; 17 | 18 | PARM(1, ANYTYPE); 19 | test = vec_pop(env->stck); 20 | jump = vec_pop(env->prog); 21 | if (test.u.num) { 22 | vec_setsize(env->prog, jump.u.num); 23 | code(env, true_); 24 | } 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /src/rollup.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rollup.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ROLLUP_C 7 | #define ROLLUP_C 8 | 9 | /** 10 | Q0 OK 1230 rollup : DDDAAA X Y Z -> Z X Y 11 | Moves X and Y up, moves Z down. 12 | */ 13 | void rollup_(pEnv env) 14 | { 15 | Node first, second, third; 16 | 17 | PARM(3, ANYTYPE); 18 | third = vec_pop(env->stck); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | vec_push(env->stck, third); 22 | vec_push(env->stck, first); 23 | vec_push(env->stck, second); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/swapd.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : swapd.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SWAPD_C 7 | #define SWAPD_C 8 | 9 | /** 10 | Q0 OK 1280 swapd : DDDAAA X Y Z -> Y X Z 11 | As if defined by: swapd == [swap] dip 12 | */ 13 | void swapd_(pEnv env) 14 | { 15 | Node first, second, third; 16 | 17 | PARM(3, ANYTYPE); 18 | third = vec_pop(env->stck); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | vec_push(env->stck, second); 22 | vec_push(env->stck, first); 23 | vec_push(env->stck, third); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/ifinteger.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ifinteger.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFINTEGER_C 7 | #define IFINTEGER_C 8 | 9 | /** 10 | Q2 OK 2610 ifinteger : DDDP X [T] [E] -> ... 11 | If X is an integer, executes T else executes E. 12 | */ 13 | void ifinteger_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == INTEGER_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /exec.c: -------------------------------------------------------------------------------- 1 | /* 2 | * module : exec.c 3 | * version : 1.8 4 | * date : 09/17/24 5 | */ 6 | #include "globals.h" 7 | 8 | /* 9 | * Execute a program and print the result according to the autoput settings, 10 | * if there is anything to be printed. 11 | */ 12 | void execute(pEnv env, NodeList list) 13 | { 14 | #ifdef BYTECODE 15 | if (env->bytecoding == 1) { 16 | bytecode(env, list); 17 | return; 18 | } 19 | if (env->compiling == 1) { 20 | compile(env, list); /* this compiles source code */ 21 | return; 22 | } 23 | #endif 24 | evaluate(env, list); 25 | print(env); 26 | } 27 | -------------------------------------------------------------------------------- /src/abs.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : abs.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef ABS_C 7 | #define ABS_C 8 | 9 | /** 10 | Q0 OK 1480 abs : DA N1 -> N2 11 | Integer N2 is the absolute value (0,1,2..) of integer N1, 12 | or float N2 is the absolute value (0.0 ..) of float N1. 13 | */ 14 | void abs_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, UFLOAT); 19 | node = vec_pop(env->stck); 20 | if (node.op == FLOAT_) 21 | node.u.dbl = fabs(node.u.dbl); 22 | else 23 | node.u.num = llabs(node.u.num); 24 | vec_push(env->stck, node); 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /src/fjump.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fjump.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FJUMP_C 7 | #define FJUMP_C 8 | 9 | /** 10 | Q0 OK 3420 #fjump : D -> 11 | Pop the jump location from the program stack. Pop the top of the data stack. 12 | If the top of the stack was false, jump to the location in the program stack. 13 | */ 14 | void fjump_(pEnv env) 15 | { 16 | Node test, jump; 17 | 18 | PARM(1, ANYTYPE); 19 | test = vec_pop(env->stck); 20 | jump = vec_pop(env->prog); 21 | if (!test.u.num) 22 | vec_setsize(env->prog, jump.u.num); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/fputchars.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fputchars.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FPUTCHARS_C 7 | #define FPUTCHARS_C 8 | 9 | /** 10 | Q0 OK 1960 fputchars : D S "abc.." -> S 11 | [FOREIGN] The string abc.. (no quotes) is written to the current position of 12 | stream S. 13 | */ 14 | void fputchars_(pEnv env) /* suggested by Heiko Kuhrt, as "fputstring_" */ 15 | { 16 | Node elem, node; 17 | 18 | PARM(2, FPUTCHARS); 19 | elem = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | fprintf(node.u.fil, "%s", elem.u.str); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/jfalse.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : jfalse.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef JFALSE_C 7 | #define JFALSE_C 8 | 9 | /** 10 | Q0 OK 3390 #jfalse : N -> 11 | Pop the jump location from the program stack. If the top of the data stack 12 | is false, jump to that location. 13 | */ 14 | void jfalse_(pEnv env) 15 | { 16 | Node test, jump; 17 | 18 | PARM(1, ANYTYPE); 19 | test = vec_pop(env->stck); 20 | jump = vec_pop(env->prog); 21 | if (test.u.num != 1) { 22 | vec_setsize(env->prog, jump.u.num); 23 | code(env, false_); 24 | } 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /src/rolldown.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rolldown.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ROLLDOWN_C 7 | #define ROLLDOWN_C 8 | 9 | /** 10 | Q0 OK 1240 rolldown : DDDAAA X Y Z -> Y Z X 11 | Moves Y and Z down, moves X up. 12 | */ 13 | void rolldown_(pEnv env) 14 | { 15 | Node first, second, third; 16 | 17 | PARM(3, ANYTYPE); 18 | third = vec_pop(env->stck); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | vec_push(env->stck, second); 22 | vec_push(env->stck, third); 23 | vec_push(env->stck, first); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/iflogical.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : iflogical.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef IFLOGICAL_C 7 | #define IFLOGICAL_C 8 | 9 | /** 10 | Q2 OK 2630 iflogical : DDDP X [T] [E] -> ... 11 | If X is a logical or truth value, executes T else executes E. 12 | */ 13 | void iflogical_(pEnv env) 14 | { 15 | Node first, second, node; 16 | 17 | PARM(3, WHILE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | node = node.op == BOOLEAN_ ? first : second; 22 | prog(env, node.u.lis); 23 | } 24 | #endif 25 | -------------------------------------------------------------------------------- /src/argv.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : argv.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef ARGV_C 7 | #define ARGV_C 8 | 9 | /** 10 | Q0 OK 3040 argv : A -> A 11 | Creates an aggregate A containing the interpreter's command line arguments. 12 | */ 13 | void argv_(pEnv env) 14 | { 15 | int i; 16 | Node node, elem; 17 | 18 | vec_init(node.u.lis); 19 | elem.op = STRING_; 20 | for (i = env->g_argc - 1; i >= 0; i--) { 21 | elem.u.str = env->g_argv[i]; 22 | vec_push(node.u.lis, elem); 23 | } 24 | node.op = LIST_; 25 | vec_push(env->stck, node); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/fput.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fput.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef FPUT_C 7 | #define FPUT_C 8 | 9 | /** 10 | Q0 OK 1940 fput : D S X -> S 11 | [FOREIGN] Writes X to stream S, pops X off stack. 12 | */ 13 | void fput_(pEnv env) 14 | { 15 | Node elem, node; 16 | 17 | PARM(2, FPUT); 18 | elem = vec_pop(env->stck); 19 | node = vec_back(env->stck); 20 | if (elem.op == LIST_) { 21 | putc('[', node.u.fil); 22 | writeterm(env, elem.u.lis, node.u.fil); 23 | putc(']', node.u.fil); 24 | } else 25 | writefactor(env, elem, node.u.fil); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/mktime.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : mktime.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef MKTIME_C 7 | #define MKTIME_C 8 | 9 | #include "decode.h" 10 | 11 | /** 12 | Q0 OK 1720 mktime : DA T -> I 13 | Converts a list T representing local time into a time I. 14 | T is in the format generated by localtime. 15 | */ 16 | void mktime_(pEnv env) 17 | { 18 | Node node; 19 | struct tm t; 20 | 21 | PARM(1, HELP); 22 | node = vec_pop(env->stck); 23 | decode(node, &t); 24 | node.u.num = mktime(&t); 25 | node.op = INTEGER_; 26 | vec_push(env->stck, node); 27 | } 28 | #endif 29 | -------------------------------------------------------------------------------- /lib/prelib.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : prelib.joy 3 | version : 1.1 4 | date : 10/11/24 5 | *) 6 | 7 | (* 8 | Some obsolescent functions are stored here, 9 | as well as some builtins that consist only 10 | of calls to other builtins. 11 | *) 12 | LIBRA 13 | _prelib == true; 14 | 15 | app1 == i; 16 | app2 == unary2; 17 | app3 == unary3; 18 | app4 == unary4; 19 | app11 == i popd; 20 | app12 == unary2 rolldown pop; 21 | fputstring == fputchars; 22 | fold == swapd step; 23 | enconcat == swapd cons concat. 24 | 25 | CONST 26 | inf == 1 1024 ldexp; 27 | -inf == inf neg. 28 | 29 | "prelib is loaded\n" putchars. 30 | -------------------------------------------------------------------------------- /src/pow.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : pow.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef POW_C 7 | #define POW_C 8 | 9 | /** 10 | Q0 OK 1630 pow : DDA F G -> H 11 | H is F raised to the Gth power. 12 | */ 13 | void pow_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, BFLOAT); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | first.u.dbl = pow(first.op == FLOAT_ ? first.u.dbl : (double)first.u.num, 21 | second.op == FLOAT_ ? second.u.dbl : (double)second.u.num); 22 | first.op = FLOAT_; 23 | vec_push(env->stck, first); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/cswap.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : cswap.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef CSWAP_C 7 | #define CSWAP_C 8 | 9 | /** 10 | Q0 OK 3330 #cswap : N -> 11 | Pop the location of an element from the code stack. 12 | Swap that element with the top of the data stack. 13 | */ 14 | void cswap_(pEnv env) 15 | { 16 | Node node, jump, elem; 17 | 18 | PARM(1, ANYTYPE); 19 | node = vec_pop(env->stck); 20 | jump = vec_pop(env->prog); 21 | elem = vec_at(env->prog, jump.u.num); 22 | vec_at(env->prog, jump.u.num) = node; /* write node */ 23 | vec_push(env->stck, elem); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/frename.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : frename.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FRENAME_C 7 | #define FRENAME_C 8 | 9 | /** 10 | Q0 OK 1930 frename : DDA P1 P2 -> B 11 | [FOREIGN] The file system object with pathname P1 is renamed to P2. 12 | B is a boolean indicating success or failure. 13 | */ 14 | void frename_(pEnv env) 15 | { 16 | Node path, node; 17 | 18 | PARM(2, FOPEN); 19 | path = vec_pop(env->stck); 20 | node = vec_pop(env->stck); 21 | node.u.num = !rename(node.u.str, path.u.str); 22 | node.op = BOOLEAN_; 23 | vec_push(env->stck, node); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/atan2.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : atan2.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ATAN2_C 7 | #define ATAN2_C 8 | 9 | /** 10 | Q0 OK 1520 atan2 : DDA F G -> H 11 | H is the arc tangent of F / G. 12 | */ 13 | void atan2_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, BFLOAT); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | first.u.dbl = atan2(first.op == FLOAT_ ? first.u.dbl : (double)first.u.num, 21 | second.op == FLOAT_ ? second.u.dbl : (double)second.u.num); 22 | first.op = FLOAT_; 23 | vec_push(env->stck, first); 24 | } 25 | #endif 26 | -------------------------------------------------------------------------------- /src/pick.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : pick.c 3 | version : 1.15 4 | date : 09/17/24 5 | */ 6 | #ifndef PICK_C 7 | #define PICK_C 8 | 9 | /** 10 | Q0 OK 3190 pick : DA X Y Z 2 -> X Y Z X 11 | [EXT] Pushes an extra copy of nth (e.g. 2) item X on top of the stack. 12 | */ 13 | void pick_(pEnv env) 14 | { 15 | int size; 16 | Node node; 17 | 18 | PARM(1, UNMKTIME); 19 | node = vec_pop(env->stck); 20 | size = vec_size(env->stck); 21 | if (node.u.num < size) 22 | node = vec_at(env->stck, size - node.u.num - 1); 23 | else 24 | node = vec_at(env->stck, 0); 25 | vec_push(env->stck, node); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/sign.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : sign.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef SIGN_C 7 | #define SIGN_C 8 | 9 | /** 10 | Q0 OK 1440 sign : DA N1 -> N2 11 | Integer N2 is the sign (-1 or 0 or +1) of integer N1, 12 | or float N2 is the sign (-1.0 or 0.0 or 1.0) of float N1. 13 | */ 14 | void sign_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, UFLOAT); 19 | node = vec_pop(env->stck); 20 | if (node.op == FLOAT_) 21 | node.u.dbl = node.u.dbl < 0 ? -1 : node.u.dbl > 0; 22 | else 23 | node.u.num = node.u.num < 0 ? -1 : node.u.num > 0; 24 | vec_push(env->stck, node); 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /lib/joytut.com: -------------------------------------------------------------------------------- 1 | ! FILE: joytut.inp 2 | ! Use thus: @joytut.com/output=joytut.out 3 | ! Then type ^Z to get it started. 4 | $ run joy 5 | 6 | "joytut.joy" include. 7 | 1 setecho. 8 | 9 | (* input that might have come from a terminal *) 10 | 11 | joytut. 12 | hahaha 13 | 1234 14 | 42 15 | 36 16 | 5 17 | 7 18 | [2 4 7] 19 | [ 8 9 3 ] 20 | [ [5 3] 5 3] 21 | [ [5 3] 5 3] 22 | [73] 23 | [ 9 4 16] 24 | [ 10 + ] 25 | [5 3 7] 26 | [ 20 <] 27 | 15 28 | -8 29 | [ 0 =] 30 | [ succ ] 31 | [ factorial *] 32 | [ dup pred ] 33 | [ * ] 34 | 2 35 | [6 4 8] 36 | [ 10 + ] 37 | [5 3 7] 38 | [ 20 <] 39 | 999 40 | -------------------------------------------------------------------------------- /src/eql.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : eql.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef EQL_C 7 | #define EQL_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2270 =\0equals : DDA X Y -> B 13 | Either both X and Y are numeric or both are strings or symbols. 14 | Tests whether X equal to Y. Also supports float. 15 | */ 16 | void eql_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | first.u.num = Compare(env, first, second) == 0; 24 | first.op = BOOLEAN_; 25 | vec_push(env->stck, first); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/compare.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : compare.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef COMPARE_C 7 | #define COMPARE_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2050 compare : DDA A B -> I 13 | I (=-1,0,+1) is the comparison of aggregates A and B. 14 | The values correspond to the predicates <=, =, >=. 15 | */ 16 | void compare_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | first.u.num = Compare(env, first, second); 24 | first.op = INTEGER_; 25 | vec_push(env->stck, first); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/fopen.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fopen.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FOPEN_C 7 | #define FOPEN_C 8 | 9 | /** 10 | Q0 OK 1890 fopen : DDA P M -> S 11 | [FOREIGN] The file system object with pathname P is opened with mode M 12 | (r, w, a, etc.) and stream object S is pushed; if the open fails, file:NULL 13 | is pushed. 14 | */ 15 | void fopen_(pEnv env) 16 | { 17 | Node mode, path; 18 | 19 | PARM(2, FOPEN); 20 | mode = vec_pop(env->stck); 21 | path = vec_pop(env->stck); 22 | path.u.fil = fopen(path.u.str, mode.u.str); 23 | path.op = FILE_; 24 | vec_push(env->stck, path); 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /src/neql.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : neql.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef NEQL_C 7 | #define NEQL_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2260 !=\0neql : DDA X Y -> B 13 | Either both X and Y are numeric or both are strings or symbols. 14 | Tests whether X not equal to Y. Also supports float. 15 | */ 16 | void neql_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | first.u.num = Compare(env, first, second) != 0; 24 | first.op = BOOLEAN_; 25 | vec_push(env->stck, first); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/not.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : not.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef NOT_C 7 | #define NOT_C 8 | 9 | /** 10 | Q0 OK 1370 not : DA X -> Y 11 | Y is the complement of set X, logical negation for truth values. 12 | */ 13 | void not_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, NOT); 18 | node = vec_pop(env->stck); 19 | switch (node.op) { 20 | case SET_: 21 | node.u.set = ~node.u.set; 22 | break; 23 | case BOOLEAN_: 24 | case CHAR_: 25 | case INTEGER_: 26 | node.u.num = !node.u.num; 27 | node.op = BOOLEAN_; 28 | break; 29 | } 30 | vec_push(env->stck, node); 31 | } 32 | #endif 33 | -------------------------------------------------------------------------------- /src/sametype.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : sametype.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef SAMETYPE_C 7 | #define SAMETYPE_C 8 | 9 | /** 10 | Q0 OK 3210 sametype : DDA X Y -> B 11 | [EXT] Tests whether X and Y have the same type. 12 | */ 13 | void sametype_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, ANYTYPE); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | if (first.op == ANON_FUNCT_) 21 | first.u.num = first.u.proc == second.u.proc; 22 | else 23 | first.u.num = first.op == second.op; 24 | first.op = BOOLEAN_; 25 | vec_push(env->stck, first); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/modf.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : modf.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef MODF_C 7 | #define MODF_C 8 | 9 | /** 10 | Q0 OK 1620 modf : DAA F -> G H 11 | G is the fractional part and H is the integer part 12 | (but expressed as a float) of F. 13 | */ 14 | void modf_(pEnv env) 15 | { 16 | Node node; 17 | double exp; 18 | 19 | PARM(1, UFLOAT); 20 | node = vec_pop(env->stck); 21 | node.u.dbl = modf(node.op == FLOAT_ ? node.u.dbl : node.u.num, &exp); 22 | node.op = FLOAT_; 23 | vec_push(env->stck, node); 24 | node.u.dbl = exp; 25 | node.op = FLOAT_; 26 | vec_push(env->stck, node); 27 | } 28 | #endif 29 | -------------------------------------------------------------------------------- /src/strtol.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : strtol.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef STRTOL_C 7 | #define STRTOL_C 8 | 9 | /** 10 | Q0 OK 1740 strtol : DDA S I -> J 11 | String S is converted to the integer J using base I. 12 | If I = 0, assumes base 10, 13 | but leading "0" means base 8 and leading "0x" means base 16. 14 | */ 15 | void strtol_(pEnv env) 16 | { 17 | Node first, second; 18 | 19 | PARM(2, STRTOL); 20 | second = vec_pop(env->stck); 21 | first = vec_pop(env->stck); 22 | first.u.num = strtol(first.u.str, 0, second.u.num); 23 | first.op = INTEGER_; 24 | vec_push(env->stck, first); 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /test2/putchars.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : putchars.joy 3 | version : 1.10 4 | date : 08/29/24 5 | *) 6 | "test" putchars newline. 7 | 8 | (* cast to bignum, that is printed without enclosing quotes, as desired *) 9 | # "Hello, World" 12 casting. 10 | 11 | (* 12 | 1 is not allowed in a string constant; 13 | it is allowed in a character constant 14 | *) 15 | # '\001 1 =. 16 | 17 | (* 18 | Bignum type exists, but is only supported when printing, not during eval. 19 | *) 20 | # "Hello" 12 casting call. 21 | 22 | (* 23 | The ILLEGAL_ type also exists, but is not supported anywhere. 24 | *) 25 | # "Hello" 0 casting. 26 | # "Hello" 0 casting "World" 0 casting pairlist i. 27 | -------------------------------------------------------------------------------- /src/rollupd.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rollupd.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef ROLLUPD_C 7 | #define ROLLUPD_C 8 | 9 | /** 10 | Q0 OK 1290 rollupd : DDDDAAAA X Y Z W -> Z X Y W 11 | As if defined by: rollupd == [rollup] dip 12 | */ 13 | void rollupd_(pEnv env) 14 | { 15 | Node first, second, third, fourth; 16 | 17 | PARM(4, ANYTYPE); 18 | fourth = vec_pop(env->stck); 19 | third = vec_pop(env->stck); 20 | second = vec_pop(env->stck); 21 | first = vec_pop(env->stck); 22 | vec_push(env->stck, third); 23 | vec_push(env->stck, first); 24 | vec_push(env->stck, second); 25 | vec_push(env->stck, fourth); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/rotated.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rotated.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef ROTATED_C 7 | #define ROTATED_C 8 | 9 | /** 10 | Q0 OK 1310 rotated : DDDDAAAA X Y Z W -> Z Y X W 11 | As if defined by: rotated == [rotate] dip 12 | */ 13 | void rotated_(pEnv env) 14 | { 15 | Node first, second, third, fourth; 16 | 17 | PARM(4, ANYTYPE); 18 | fourth = vec_pop(env->stck); 19 | third = vec_pop(env->stck); 20 | second = vec_pop(env->stck); 21 | first = vec_pop(env->stck); 22 | vec_push(env->stck, third); 23 | vec_push(env->stck, second); 24 | vec_push(env->stck, first); 25 | vec_push(env->stck, fourth); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /test2/split.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : split.joy 3 | version : 1.7 4 | date : 08/29/24 5 | *) 6 | [1 2 3 4 5 6 7 8 9] [5 <] split stack [[5 6 7 8 9] [1 2 3 4]] equal. 7 | pop pop "test" ['t <] split stack ["tt" "es"] equal. 8 | pop pop {1 2 3} [2 <] split stack [{2 3} {1}] equal. 9 | 10 | [] unstack. 11 | [] [2 <] split stack [[] []] equal. 12 | [] unstack. 13 | "" ['t <] split stack ["" ""] equal. 14 | [] unstack. 15 | {} [2 <] split stack [{} {}] equal. 16 | 17 | [] unstack. 18 | [1 2 3] [] split stack [[] [1 2 3]] equal. 19 | [] unstack. 20 | "test" [] split stack ["" "test"] equal. 21 | [] unstack. 22 | {1 2 3} [] split stack [{} {1 2 3}] equal. 23 | 24 | (* error *) 25 | # 'A [] split. 26 | -------------------------------------------------------------------------------- /src/rolldownd.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rolldownd.c 3 | version : 1.8 4 | date : 5 | */ 6 | #ifndef ROLLDOWND_C 7 | #define ROLLDOWND_C 8 | 9 | /** 10 | Q0 OK 1300 rolldownd : DDDDAAAA X Y Z W -> Y Z X W 11 | As if defined by: rolldownd == [rolldown] dip 12 | */ 13 | void rolldownd_(pEnv env) 14 | { 15 | Node first, second, third, fourth; 16 | 17 | PARM(4, ANYTYPE); 18 | fourth = vec_pop(env->stck); 19 | third = vec_pop(env->stck); 20 | second = vec_pop(env->stck); 21 | first = vec_pop(env->stck); 22 | vec_push(env->stck, second); 23 | vec_push(env->stck, third); 24 | vec_push(env->stck, first); 25 | vec_push(env->stck, fourth); 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/intern.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : intern.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef INTERN_C 7 | #define INTERN_C 8 | 9 | /** 10 | Q0 OK 2180 intern : DA "sym" -> sym 11 | Pushes the item whose name is "sym". 12 | */ 13 | void intern_(pEnv env) 14 | { 15 | Node node; 16 | int index; 17 | Entry ent; 18 | 19 | PARM(1, INTERN); 20 | node = vec_pop(env->stck); 21 | index = lookup(env, node.u.str); 22 | ent = vec_at(env->symtab, index); 23 | if (ent.is_user) { 24 | node.op = USR_; 25 | node.u.ent = index; 26 | } else { 27 | node.op = ANON_FUNCT_; 28 | node.u.proc = ent.u.proc; 29 | } 30 | vec_push(env->stck, node); 31 | } 32 | #endif 33 | -------------------------------------------------------------------------------- /print.c: -------------------------------------------------------------------------------- 1 | /* 2 | * module : print.c 3 | * version : 1.1 4 | * date : 09/17/24 5 | */ 6 | #include "globals.h" 7 | 8 | /* 9 | * print the stack according to the autoput settings. 10 | */ 11 | void print(pEnv env) 12 | { 13 | Node node; 14 | 15 | if (vec_size(env->stck)) { 16 | if (env->autoput == 2) 17 | writeterm(env, env->stck, stdout); 18 | else if (env->autoput == 1) { 19 | node = vec_pop(env->stck); 20 | if (node.op == LIST_) { 21 | putchar('['); 22 | writeterm(env, node.u.lis, stdout); 23 | putchar(']'); 24 | } else 25 | writefactor(env, node, stdout); 26 | } 27 | if (env->autoput) { 28 | putchar('\n'); 29 | fflush(stdout); 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /src/div.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : div.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef DIV_C 7 | #define DIV_C 8 | 9 | /** 10 | Q0 OK 1430 div : DDAA I J -> K L 11 | Integers K and L are the quotient and remainder of dividing I by J. 12 | */ 13 | void div_(pEnv env) 14 | { 15 | Node first, second; 16 | int64_t quotient, remainder; 17 | 18 | PARM(2, DIV); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | quotient = first.u.num / second.u.num; 22 | remainder = first.u.num % second.u.num; 23 | first.u.num = quotient; 24 | vec_push(env->stck, first); 25 | first.u.num = remainder; 26 | vec_push(env->stck, first); 27 | } 28 | #endif 29 | -------------------------------------------------------------------------------- /src/frexp.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : frexp.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef FREXP_C 7 | #define FREXP_C 8 | 9 | /** 10 | Q0 OK 1580 frexp : DAA F -> G I 11 | G is the mantissa and I is the exponent of F. 12 | Unless F = 0, 0.5 <= abs(G) < 1.0. 13 | */ 14 | void frexp_(pEnv env) 15 | { 16 | int exp; 17 | Node node; 18 | 19 | PARM(1, UFLOAT); 20 | node = vec_pop(env->stck); 21 | if (node.op != FLOAT_) { 22 | node.u.dbl = node.u.num; 23 | node.op = FLOAT_; 24 | } 25 | node.u.dbl = frexp(node.u.dbl, &exp); 26 | vec_push(env->stck, node); 27 | node.u.num = exp; 28 | node.op = INTEGER_; 29 | vec_push(env->stck, node); 30 | } 31 | #endif 32 | -------------------------------------------------------------------------------- /src/fseek.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fseek.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FSEEK_C 7 | #define FSEEK_C 8 | 9 | /** 10 | Q0 OK 1980 fseek : DDA S P W -> S B 11 | [FOREIGN] Stream S is repositioned to position P relative to whence-point W, 12 | where W = 0, 1, 2 for beginning, current position, end respectively. 13 | */ 14 | void fseek_(pEnv env) 15 | { 16 | Node orien, locat, node; 17 | 18 | PARM(3, FSEEK); 19 | orien = vec_pop(env->stck); 20 | locat = vec_pop(env->stck); 21 | node = vec_back(env->stck); 22 | node.u.num = fseek(node.u.fil, locat.u.num, orien.u.num) != 0; 23 | node.op = BOOLEAN_; 24 | vec_push(env->stck, node); 25 | } 26 | #endif 27 | -------------------------------------------------------------------------------- /xerr.c: -------------------------------------------------------------------------------- 1 | /* 2 | * module : xerr.c 3 | * version : 1.5 4 | * date : 10/11/24 5 | */ 6 | #include "globals.h" 7 | 8 | /* 9 | print a runtime error to stderr and abort the execution of current program. 10 | */ 11 | void execerror(char *message, char *op) 12 | { 13 | int leng = 0; 14 | char *ptr, *str; 15 | 16 | if ((ptr = strrchr(op, '/')) != 0) 17 | ptr++; 18 | else 19 | ptr = op; 20 | if ((str = strrchr(ptr, '.')) != 0 && str[1] == 'c') 21 | leng = str - ptr; 22 | else 23 | leng = strlen(ptr); 24 | fflush(stdout); 25 | fprintf(stderr, "\nrun time error: %s needed for %.*s\n", message, leng, 26 | ptr); 27 | abortexecution_(ABORT_ERROR); 28 | } /* LCOV_EXCL_LINE */ 29 | -------------------------------------------------------------------------------- /src/nullary.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : nullary.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef NULLARY_C 7 | #define NULLARY_C 8 | 9 | /** 10 | Q0 OK 2480 nullary : DA [P] -> R 11 | Executes P, which leaves R on top of the stack. 12 | No matter how many parameters this consumes, none are removed from the stack. 13 | */ 14 | void nullary_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, DIP); 19 | /* 20 | read the program from the stack 21 | */ 22 | node = vec_pop(env->stck); 23 | /* 24 | the old stack is saved and restored with the new top. 25 | */ 26 | save(env, 0, 0, 0); 27 | /* 28 | execute program 29 | */ 30 | prog(env, node.u.lis); 31 | } 32 | #endif 33 | -------------------------------------------------------------------------------- /src/binary.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : binary.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef BINARY_C 7 | #define BINARY_C 8 | 9 | /** 10 | Q1 OK 2560 binary : DDDA X Y [P] -> R 11 | Executes P, which leaves R on top of the stack. 12 | No matter how many parameters this consumes, 13 | exactly two are removed from the stack. 14 | */ 15 | void binary_(pEnv env) 16 | { 17 | Node node; 18 | 19 | PARM(3, DIP); 20 | node = vec_pop(env->stck); 21 | /* 22 | the old stack is saved without the former top and restored with the new 23 | top. 24 | */ 25 | save(env, 0, 0, 2); 26 | /* 27 | the program on top of the stack is executed 28 | */ 29 | prog(env, node.u.lis); 30 | } 31 | #endif 32 | -------------------------------------------------------------------------------- /src/undefs.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : undefs.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef UNDEFS_C 7 | #define UNDEFS_C 8 | 9 | /** 10 | Q0 OK 1110 undefs : A -> [..] 11 | Push a list of all undefined symbols in the current symbol table. 12 | */ 13 | void undefs_(pEnv env) 14 | { 15 | int i; 16 | Entry ent; 17 | Node node, elem; 18 | 19 | vec_init(node.u.lis); 20 | node.op = LIST_; 21 | elem.op = STRING_; 22 | for (i = vec_size(env->symtab) - 1; i; i--) { 23 | ent = vec_at(env->symtab, i); 24 | if (ent.name[0] && ent.name[0] != '_' && !ent.u.body) { 25 | elem.u.str = ent.name; 26 | vec_push(node.u.lis, elem); 27 | } 28 | } 29 | vec_push(env->stck, node); 30 | } 31 | #endif 32 | -------------------------------------------------------------------------------- /src/and.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : and.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef AND_C 7 | #define AND_C 8 | 9 | /** 10 | Q0 OK 1360 and : DDA X Y -> Z 11 | Z is the intersection of sets X and Y, logical conjunction for truth values. 12 | */ 13 | void and_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, ANDORXOR); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | switch (first.op) { 21 | case SET_: 22 | first.u.set &= second.u.set; 23 | break; 24 | case BOOLEAN_: 25 | case CHAR_: 26 | case INTEGER_: 27 | first.u.num = first.u.num && second.u.num; 28 | first.op = BOOLEAN_; 29 | break; 30 | } 31 | vec_push(env->stck, first); 32 | } 33 | #endif 34 | -------------------------------------------------------------------------------- /src/name.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : name.c 3 | version : 1.12 4 | date : 09/17/24 5 | */ 6 | #ifndef NAME_C 7 | #define NAME_C 8 | 9 | /** 10 | Q0 OK 2170 name : DA sym -> "sym" 11 | For operators and combinators, the string "sym" is the name of item sym, 12 | for literals sym the result string is its type. 13 | */ 14 | void name_(pEnv env) 15 | { 16 | Node node; 17 | 18 | PARM(1, ANYTYPE); 19 | node = vec_pop(env->stck); 20 | if (node.op == USR_) 21 | node.u.str = vec_at(env->symtab, node.u.ent).name; 22 | else if (node.op == ANON_FUNCT_) 23 | node.u.str = opername(env, node.u.proc); 24 | else 25 | node.u.str = showname(node.op); 26 | node.op = STRING_; 27 | vec_push(env->stck, node); 28 | } 29 | #endif 30 | -------------------------------------------------------------------------------- /src/or.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : or.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef OR_C 7 | #define OR_C 8 | 9 | /** 10 | Q0 OK 1340 or : DDA X Y -> Z 11 | Z is the union of sets X and Y, logical disjunction for truth values. 12 | */ 13 | void or_(pEnv env) 14 | { 15 | Node first, second; 16 | 17 | PARM(2, ANDORXOR); 18 | second = vec_pop(env->stck); 19 | first = vec_pop(env->stck); 20 | switch (first.op) { 21 | case SET_: 22 | first.u.set = first.u.set | second.u.set; 23 | break; 24 | case BOOLEAN_: 25 | case CHAR_: 26 | case INTEGER_: 27 | first.u.num = first.u.num || second.u.num; 28 | first.op = BOOLEAN_; 29 | break; 30 | } 31 | vec_push(env->stck, first); 32 | } 33 | #endif 34 | -------------------------------------------------------------------------------- /src/fwrite.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fwrite.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FWRITE_C 7 | #define FWRITE_C 8 | 9 | /** 10 | Q0 OK 1910 fwrite : D S L -> S 11 | [FOREIGN] A list of integers are written as bytes to the current position of 12 | stream S. 13 | */ 14 | void fwrite_(pEnv env) 15 | { 16 | int i, j; 17 | unsigned char *buf; 18 | Node elem, node, temp; 19 | 20 | PARM(2, FWRITE); 21 | elem = vec_pop(env->stck); 22 | node = vec_back(env->stck); 23 | j = vec_size(elem.u.lis); 24 | buf = GC_malloc_atomic(j); 25 | for (i = 0; i < j; i++) { 26 | temp = vec_at(elem.u.lis, j - i - 1); 27 | buf[i] = temp.u.num; 28 | } 29 | fwrite(buf, 1, j, node.u.fil); 30 | } 31 | #endif 32 | -------------------------------------------------------------------------------- /src/condlinrec.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : condlinrec.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef CONDLINREC_C 7 | #define CONDLINREC_C 8 | 9 | /** 10 | Q1 OK 2760 condlinrec : DDA [ [C1] [C2] .. [D] ] -> ... 11 | Each [Ci] is of the form [[B] [T]] or [[B] [R1] [R2]]. 12 | Tries each B. If that yields true and there is just a [T], executes T and exit. 13 | If there are [R1] and [R2], executes R1, recurses, executes R2. 14 | Subsequent case are ignored. If no B yields true, then [D] is used. 15 | It is then of the form [[T]] or [[R1] [R2]]. For the former, executes T. 16 | For the latter executes R1, recurses, executes R2. 17 | */ 18 | void condlinrec_(pEnv env) 19 | { 20 | PARM(1, CASE); 21 | condnestrec_(env); 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /src/finclude.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : finclude.c 3 | version : 1.14 4 | date : 09/17/24 5 | */ 6 | #ifndef FINCLUDE_C 7 | #define FINCLUDE_C 8 | 9 | /** 10 | Q0 OK 3170 finclude : DU S -> F ... 11 | [FOREIGN] Reads Joy source code from stream S and pushes it onto stack. 12 | */ 13 | void finclude_(pEnv env) 14 | { 15 | Node node; 16 | 17 | PARM(1, STRTOD); 18 | node = vec_pop(env->stck); /* remove file name */ 19 | if (include(env, node.u.str)) /* test whether file exists */ 20 | return; 21 | env->finclude_busy = 1; /* tell scanner about finclude */ 22 | if (setjmp(env->finclude)) 23 | env->finclude_busy = 0; /* done with finclude */ 24 | else while (1) 25 | get_(env); /* read all factors from file */ 26 | } 27 | #endif 28 | -------------------------------------------------------------------------------- /src/strftime.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : strftime.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef STRFTIME_C 7 | #define STRFTIME_C 8 | 9 | #include "decode.h" 10 | 11 | /** 12 | Q0 OK 1730 strftime : DDA T S1 -> S2 13 | Formats a list T in the format of localtime or gmtime 14 | using string S1 and pushes the result S2. 15 | */ 16 | void strftime_(pEnv env) 17 | { 18 | struct tm t; 19 | Node first, second; 20 | 21 | PARM(2, STRFTIME); 22 | second = vec_pop(env->stck); 23 | first = vec_pop(env->stck); 24 | decode(first, &t); 25 | first.u.str = GC_malloc_atomic(INPLINEMAX); 26 | strftime(first.u.str, INPLINEMAX, second.u.str, &t); 27 | first.op = STRING_; 28 | vec_push(env->stck, first); 29 | } 30 | #endif 31 | -------------------------------------------------------------------------------- /src/_help.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : _help.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef _HELP_C 7 | #define _HELP_C 8 | 9 | /** 10 | Q0 IGNORE_OK 2910 _help : N -> 11 | [IMPURE] Lists all hidden symbols in library and then all hidden builtin 12 | symbols. 13 | */ 14 | void _help_(pEnv env) 15 | { 16 | Entry ent; 17 | int name_length, column = 0, i = vec_size(env->symtab); 18 | 19 | while (i) { 20 | ent = vec_at(env->symtab, --i); 21 | if (strchr("#_", ent.name[0])) { 22 | name_length = strlen(ent.name) + 1; 23 | if (column + name_length > HELPLINEMAX) { 24 | putchar('\n'); 25 | column = 0; 26 | } 27 | printf("%s ", ent.name); 28 | column += name_length; 29 | } 30 | } 31 | putchar('\n'); 32 | } 33 | #endif 34 | -------------------------------------------------------------------------------- /src/leql.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : leql.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LEQL_C 7 | #define LEQL_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2240 <=\0leql : DDA X Y -> B 13 | Either both X and Y are numeric or both are strings or symbols. 14 | Tests whether X less than or equal to Y. Also supports float. 15 | */ 16 | void leql_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | if (first.op == SET_ || second.op == SET_) 24 | first.u.num = !(first.u.set & ~second.u.set); 25 | else 26 | first.u.num = Compare(env, first, second) <= 0; 27 | first.op = BOOLEAN_; 28 | vec_push(env->stck, first); 29 | } 30 | #endif 31 | -------------------------------------------------------------------------------- /src/geql.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : geql.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef GEQL_C 7 | #define GEQL_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2220 >=\0geql : DDA X Y -> B 13 | Either both X and Y are numeric or both are strings or symbols. 14 | Tests whether X greater than or equal to Y. Also supports float. 15 | */ 16 | void geql_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | if (first.op == SET_ || second.op == SET_) 24 | first.u.num = !(second.u.set & ~first.u.set); 25 | else 26 | first.u.num = Compare(env, first, second) >= 0; 27 | first.op = BOOLEAN_; 28 | vec_push(env->stck, first); 29 | } 30 | #endif 31 | -------------------------------------------------------------------------------- /src/unary.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : unary.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef UNARY_C 7 | #define UNARY_C 8 | 9 | /** 10 | Q1 OK 2490 unary : DDA X [P] -> R 11 | Executes P, which leaves R on top of the stack. 12 | No matter how many parameters this consumes, 13 | exactly one is removed from the stack. 14 | */ 15 | void unary_(pEnv env) 16 | { 17 | Node node; 18 | 19 | PARM(2, DIP); 20 | /* 21 | remove the program from the stack 22 | */ 23 | node = vec_pop(env->stck); 24 | /* 25 | the old stack is saved without the former top and restored with the new 26 | top. 27 | */ 28 | save(env, 0, 0, 1); 29 | /* 30 | the program on top of the stack is executed 31 | */ 32 | prog(env, node.u.lis); 33 | } 34 | #endif 35 | -------------------------------------------------------------------------------- /src/xor.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : xor.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef XOR_C 7 | #define XOR_C 8 | 9 | /** 10 | Q0 OK 1350 xor : DDA X Y -> Z 11 | Z is the symmetric difference of sets X and Y, 12 | logical exclusive disjunction for truth values. 13 | */ 14 | void xor_(pEnv env) 15 | { 16 | Node first, second; 17 | 18 | PARM(2, ANDORXOR); 19 | second = vec_pop(env->stck); 20 | first = vec_pop(env->stck); 21 | switch (first.op) { 22 | case SET_: 23 | first.u.set = first.u.set ^ second.u.set; 24 | break; 25 | case BOOLEAN_: 26 | case CHAR_: 27 | case INTEGER_: 28 | first.u.num = first.u.num != second.u.num; 29 | first.op = BOOLEAN_; 30 | break; 31 | } 32 | vec_push(env->stck, first); 33 | } 34 | #endif 35 | -------------------------------------------------------------------------------- /src/ternary.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : ternary.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef TERNARY_C 7 | #define TERNARY_C 8 | 9 | /** 10 | Q1 OK 2570 ternary : DDDDA X Y Z [P] -> R 11 | Executes P, which leaves R on top of the stack. 12 | No matter how many parameters this consumes, 13 | exactly three are removed from the stack. 14 | */ 15 | void ternary_(pEnv env) 16 | { 17 | Node node; 18 | 19 | PARM(4, DIP); 20 | /* 21 | read the program from the stack 22 | */ 23 | node = vec_pop(env->stck); 24 | /* 25 | the old stack is saved without the former top and restored with the new 26 | top. 27 | */ 28 | save(env, 0, 0, 3); 29 | /* 30 | the program on top of the stack is executed 31 | */ 32 | prog(env, node.u.lis); 33 | } 34 | #endif 35 | -------------------------------------------------------------------------------- /src/fgets.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fgets.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef FGETS_C 7 | #define FGETS_C 8 | 9 | /** 10 | Q0 OK 1880 fgets : A S -> S L 11 | [FOREIGN] L is the next available line (as a string) from stream S. 12 | */ 13 | void fgets_(pEnv env) 14 | { 15 | Node node; 16 | char *buf; 17 | size_t leng, size = INPLINEMAX; 18 | 19 | PARM(1, FGET); 20 | node = vec_back(env->stck); 21 | buf = GC_malloc_atomic(size); 22 | buf[leng = 0] = 0; 23 | while (fgets(buf + leng, size - leng, node.u.fil)) { 24 | if ((leng = strlen(buf)) > 0 && buf[leng - 1] == '\n') 25 | break; 26 | buf = GC_realloc(buf, size <<= 1); 27 | } 28 | node.u.str = buf; 29 | node.op = STRING_; 30 | vec_push(env->stck, node); 31 | } 32 | #endif 33 | -------------------------------------------------------------------------------- /src/less.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : less.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef LESS_C 7 | #define LESS_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2250 <\0less : DDA X Y -> B 13 | Either both X and Y are numeric or both are strings or symbols. 14 | Tests whether X less than Y. Also supports float. 15 | */ 16 | void less_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | if (first.op == SET_ || second.op == SET_) 24 | first.u.num = first.u.set != second.u.set && 25 | !(first.u.set & ~second.u.set); 26 | else 27 | first.u.num = Compare(env, first, second) < 0; 28 | first.op = BOOLEAN_; 29 | vec_push(env->stck, first); 30 | } 31 | #endif 32 | -------------------------------------------------------------------------------- /src/greater.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : greater.c 3 | version : 1.8 4 | date : 09/17/24 5 | */ 6 | #ifndef GREATER_C 7 | #define GREATER_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q0 OK 2230 >\0greater : DDA X Y -> B 13 | Either both X and Y are numeric or both are strings or symbols. 14 | Tests whether X greater than Y. Also supports float. 15 | */ 16 | void greater_(pEnv env) 17 | { 18 | Node first, second; 19 | 20 | PARM(2, ANYTYPE); 21 | second = vec_pop(env->stck); 22 | first = vec_pop(env->stck); 23 | if (first.op == SET_ || second.op == SET_) 24 | first.u.num = first.u.set != second.u.set && 25 | !(second.u.set & ~first.u.set); 26 | else 27 | first.u.num = Compare(env, first, second) > 0; 28 | first.op = BOOLEAN_; 29 | vec_push(env->stck, first); 30 | } 31 | #endif 32 | -------------------------------------------------------------------------------- /src/size.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : size.c 3 | version : 1.12 4 | date : 09/17/24 5 | */ 6 | #ifndef SIZE_C 7 | #define SIZE_C 8 | 9 | /** 10 | Q0 OK 2080 size : DA A -> I 11 | Integer I is the number of elements of aggregate A. 12 | */ 13 | void size_(pEnv env) 14 | { 15 | int64_t i, j; 16 | Node node, temp; 17 | 18 | PARM(1, SIZE_); 19 | node = vec_pop(env->stck); 20 | switch (node.op) { 21 | case LIST_: 22 | temp.u.num = vec_size(node.u.lis); 23 | break; 24 | case STRING_: 25 | case BIGNUM_: 26 | temp.u.num = strlen(node.u.str); 27 | break; 28 | case SET_: 29 | for (temp.u.num = 0, j = 1, i = 0; i < SETSIZE; i++, j <<= 1) 30 | if (node.u.set & j) 31 | temp.u.num++; 32 | break; 33 | } 34 | temp.op = INTEGER_; 35 | vec_push(env->stck, temp); 36 | } 37 | #endif 38 | -------------------------------------------------------------------------------- /test2/formatf.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : formatf.joy 3 | version : 1.8 4 | date : 08/27/24 5 | *) 6 | 7 | (* total width, number of decimals *) 8 | 9 | 12345.6789 'e 12 4 formatf " 1.2346e+04" =. 10 | 12345.6789 'e -12 4 formatf "1.2346e+04 " =. 11 | 12 | 12345.6789 'f 12 3 formatf " 12345.679" =. 13 | 12345.6789 'f -12 3 formatf "12345.679 " =. 14 | 15 | (* total width, number of digits *) 16 | 17 | 12345.6789 'g 12 4 formatf " 1.235e+04" =. 18 | 12345.6789 'g -12 4 formatf "1.235e+04 " =. 19 | 20 | 1.93456789 'g 12 1 formatf " 2" =. 21 | 1.93456789 'g -12 1 formatf "2 " =. 22 | 23 | 1234.56 'g 12 3 formatf " 1.23e+03" =. 24 | 1234.56 'g -12 3 formatf "1.23e+03 " =. 25 | 26 | 12345.67 'g 12 4 formatf " 1.235e+04" =. 27 | 12345.67 'g -12 4 formatf "1.235e+04 " =. 28 | -------------------------------------------------------------------------------- /src/filetime.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : filetime.c 3 | version : 1.14 4 | date : 09/17/24 5 | */ 6 | #ifndef FILETIME_C 7 | #define FILETIME_C 8 | 9 | #include 10 | 11 | /** 12 | Q0 OK 3160 filetime : DA F -> T 13 | [FOREIGN] T is the modification time of file F. 14 | */ 15 | void filetime_(pEnv env) 16 | { 17 | FILE *fp; 18 | Node node; 19 | struct stat *buf; /* struct stat is big */ 20 | time_t mtime = 0; /* modification time */ 21 | 22 | PARM(1, STRTOD); 23 | node = vec_pop(env->stck); 24 | if ((fp = fopen(node.u.str, "r")) != 0) { 25 | buf = GC_malloc(sizeof(struct stat)); 26 | if (fstat(fileno(fp), buf) >= 0) 27 | mtime = buf->st_mtime; 28 | fclose(fp); 29 | } 30 | node.u.num = mtime; 31 | node.op = INTEGER_; 32 | vec_push(env->stck, node); 33 | } 34 | #endif 35 | -------------------------------------------------------------------------------- /src/first.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : first.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef FIRST_C 7 | #define FIRST_C 8 | 9 | /** 10 | Q0 OK 2030 first : DA A -> F 11 | F is the first member of the non-empty aggregate A. 12 | */ 13 | void first_(pEnv env) 14 | { 15 | int i = 0; 16 | Node node; 17 | 18 | PARM(1, FIRST); 19 | node = vec_pop(env->stck); 20 | switch (node.op) { 21 | case LIST_: 22 | node = vec_back(node.u.lis); 23 | break; 24 | 25 | case STRING_: 26 | case BIGNUM_: 27 | case USR_STRING_: 28 | node.u.num = *node.u.str; 29 | node.op = CHAR_; 30 | break; 31 | 32 | case SET_: 33 | while (!(node.u.set & ((int64_t)1 << i))) 34 | i++; 35 | node.u.num = i; 36 | node.op = INTEGER_; 37 | break; 38 | } 39 | vec_push(env->stck, node); 40 | } 41 | #endif 42 | -------------------------------------------------------------------------------- /src/decode.h: -------------------------------------------------------------------------------- 1 | /* 2 | module : decode.h 3 | version : 1.7 4 | date : 09/17/24 5 | */ 6 | #ifndef DECODE_H 7 | #define DECODE_H 8 | 9 | void decode(Node node, struct tm *t) 10 | { 11 | int i; 12 | Node temp; 13 | 14 | memset(t, 0, sizeof(struct tm)); 15 | for (i = vec_size(node.u.lis) - 1; i >= 0; i--) { 16 | temp = vec_at(node.u.lis, i); 17 | switch (i) { 18 | case 8: t->tm_year = temp.u.num - 1900; break; 19 | case 7: t->tm_mon = temp.u.num - 1; break; 20 | case 6: t->tm_mday = temp.u.num; break; 21 | case 5: t->tm_hour = temp.u.num; break; 22 | case 4: t->tm_min = temp.u.num; break; 23 | case 3: t->tm_sec = temp.u.num; break; 24 | case 2: t->tm_isdst = temp.u.num; break; 25 | case 1: t->tm_yday = temp.u.num; break; 26 | case 0: t->tm_wday = temp.u.num % 7; break; 27 | } 28 | } 29 | } 30 | #endif 31 | -------------------------------------------------------------------------------- /test2/null.joy: -------------------------------------------------------------------------------- 1 | (* 2 | module : null.joy 3 | version : 1.7 4 | date : 11/15/24 5 | *) 6 | [pop] first null false =. 7 | [sum] first null false =. 8 | false null. 9 | true null false =. 10 | '\002 null not. 11 | 'A null false =. 12 | 0 null. 13 | 10 null false =. 14 | {} null. 15 | {1 2 3} null false =. 16 | "" null. 17 | "test" null false =. 18 | [] null. 19 | [1 2 3] null false =. 20 | -0.0 null. 21 | 0.0 null. 22 | 1.0 null false =. 23 | "exist" "r" fopen null. 24 | stdin null false =. 25 | 26 | [sum] first [] [true] [false] ifte. 27 | [pop] first [] [true] [false] ifte. 28 | true [] [true] [false] ifte. 29 | 'A [] [true] [false] ifte. 30 | 1 [] [true] [false] ifte. 31 | {0} [] [true] [false] ifte. 32 | "A" [] [true] [false] ifte. 33 | [0] [] [true] [false] ifte. 34 | 1.0 [] [true] [false] ifte. 35 | "exist" "r" fopen [] [false] [true] ifte. 36 | -------------------------------------------------------------------------------- /prim.sh: -------------------------------------------------------------------------------- 1 | # 2 | # module : prim.sh 3 | # version : 1.8 4 | # date : 10/11/24 5 | # 6 | # Generate builtin.c and builtin.h 7 | # The directory needs to be given as parameter. 8 | # 9 | echo checking builtin.c and builtin.h 10 | todo=0 11 | ls $1/src/*.c | sed 's/^/#include "/;s/$/"/' >builtin.tmp 12 | if [ ! -f $1/builtin.c -o ! -f $1/builtin.h ] 13 | then 14 | echo creating builtin.c and builtin.h 15 | todo=1 16 | else 17 | diff $1/builtin.c builtin.tmp 18 | if [ $? -eq 0 ] 19 | then 20 | echo builtin.c and builtin.h are up-to-date 21 | rm -f builtin.tmp 22 | else 23 | echo updating builtin.c and builtin.h 24 | todo=1 25 | fi 26 | fi 27 | if [ $todo -eq 1 ] 28 | then 29 | rm -f $1/builtin.c $1/builtin.h $1/tabl.c 30 | mv builtin.tmp $1/builtin.c 31 | sed 's/.*\//void /;s/\..*/_(pEnv env);/' <$1/builtin.c >$1/builtin.h 32 | fi 33 | -------------------------------------------------------------------------------- /src/succ.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : succ.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef SUCC_C 7 | #define SUCC_C 8 | 9 | /** 10 | Q0 OK 1800 succ : DA M -> N 11 | Numeric N is the successor of numeric M. 12 | */ 13 | void succ_(pEnv env) 14 | { 15 | Node node; 16 | #ifdef USE_BIGNUM_ARITHMETIC 17 | char *first, *second; 18 | #endif 19 | 20 | PARM(1, PREDSUCC); 21 | node = vec_pop(env->stck); 22 | #ifdef USE_BIGNUM_ARITHMETIC 23 | if (node.op == BIGNUM_ || node.u.num == MAXINT_) { 24 | second = num2big(1); 25 | if (node.u.num == MAXINT_) { 26 | first = num2big(MAXINT_); 27 | node.u.str = num_str_add(first, second); 28 | node.op = BIGNUM_; 29 | } else 30 | node.u.str = num_str_add(node.u.str, second); 31 | } else 32 | #endif 33 | node.u.num++; 34 | vec_push(env->stck, node); 35 | } 36 | #endif 37 | -------------------------------------------------------------------------------- /src/unassign.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : unassign.c 3 | version : 1.3 4 | date : 09/17/24 5 | */ 6 | #ifndef UNASSIGN_C 7 | #define UNASSIGN_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3230 unassign : D [N] -> 11 | [IMPURE] Sets the body of the name N to uninitialized. 12 | */ 13 | void unassign_(pEnv env) 14 | { 15 | Node node; 16 | int index; 17 | Entry ent; 18 | 19 | PARM(1, ASSIGN); /* quotation on top */ 20 | node = vec_pop(env->stck);; /* singleton list */ 21 | node = vec_back(node.u.lis); /* first/last element */ 22 | index = node.u.ent; /* index user defined name */ 23 | ent = vec_at(env->symtab, index); /* symbol table entry */ 24 | ent.is_user = 1; /* ensure again user defined */ 25 | ent.u.body = 0; /* (re)initialise body */ 26 | vec_at(env->symtab, index) = ent; /* update symbol table */ 27 | } 28 | #endif 29 | -------------------------------------------------------------------------------- /src/help.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : help.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef HELP_C 7 | #define HELP_C 8 | 9 | /** 10 | Q0 IGNORE_OK 2900 help : N -> 11 | [IMPURE] Lists all defined symbols, including those from library files. 12 | Then lists all primitives of raw Joy. 13 | (There is a variant: "_help" which lists hidden symbols). 14 | */ 15 | void help_(pEnv env) 16 | { 17 | Entry ent; 18 | int name_length, column = 0, i = vec_size(env->symtab); 19 | 20 | while (i) { 21 | ent = vec_at(env->symtab, --i); 22 | if (!strchr("#0123456789_", ent.name[0])) { 23 | name_length = strlen(ent.name) + 1; 24 | if (column + name_length > HELPLINEMAX) { 25 | putchar('\n'); 26 | column = 0; 27 | } 28 | printf("%s ", ent.name); 29 | column += name_length; 30 | } 31 | } 32 | putchar('\n'); 33 | } 34 | #endif 35 | -------------------------------------------------------------------------------- /src/pred.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : pred.c 3 | version : 1.9 4 | date : 09/17/24 5 | */ 6 | #ifndef PRED_C 7 | #define PRED_C 8 | 9 | /** 10 | Q0 OK 1790 pred : DA M -> N 11 | Numeric N is the predecessor of numeric M. 12 | */ 13 | void pred_(pEnv env) 14 | { 15 | Node node; 16 | #ifdef USE_BIGNUM_ARITHMETIC 17 | char *first, *second; 18 | #endif 19 | 20 | PARM(1, PREDSUCC); 21 | node = vec_pop(env->stck); 22 | #ifdef USE_BIGNUM_ARITHMETIC 23 | if (node.op == BIGNUM_ || node.u.num == -(MAXINT_)) { 24 | second = num2big(1); 25 | if (node.u.num == -(MAXINT_)) { 26 | first = num2big(-(MAXINT_)); 27 | node.u.str = num_str_sub(first, second); 28 | node.op = BIGNUM_; 29 | } else 30 | node.u.str = num_str_sub(node.u.str, second); 31 | } else 32 | #endif 33 | node.u.num--; 34 | vec_push(env->stck, node); 35 | } 36 | #endif 37 | -------------------------------------------------------------------------------- /src/fread.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : fread.c 3 | version : 1.11 4 | date : 09/17/24 5 | */ 6 | #ifndef FREAD_C 7 | #define FREAD_C 8 | 9 | /** 10 | Q0 OK 1900 fread : DA S I -> S L 11 | [FOREIGN] I bytes are read from the current position of stream S 12 | and returned as a list of I integers. 13 | */ 14 | void fread_(pEnv env) 15 | { 16 | int count; 17 | Node node, elem; 18 | unsigned char *buf; 19 | 20 | PARM(2, FREAD); 21 | node = vec_pop(env->stck); 22 | count = node.u.num; 23 | node = vec_back(env->stck); 24 | buf = GC_malloc_atomic(count); 25 | count = fread(buf, 1, count, node.u.fil); 26 | vec_init(node.u.lis); 27 | elem.op = INTEGER_; 28 | for (--count; count >= 0; count--) { 29 | elem.u.num = buf[count]; 30 | vec_push(node.u.lis, elem); 31 | } 32 | node.op = LIST_; 33 | vec_push(env->stck, node); 34 | } 35 | #endif 36 | -------------------------------------------------------------------------------- /src/case.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : case.c 3 | version : 1.10 4 | date : 11/20/24 5 | */ 6 | #ifndef CASE_C 7 | #define CASE_C 8 | 9 | #include "compare.h" 10 | 11 | /** 12 | Q1 OK 2100 case : DP X [..[X Y]..] -> Y i 13 | Indexing on the value of X, execute the matching Y. 14 | */ 15 | void case_(pEnv env) 16 | { 17 | int i; 18 | Node aggr, node, elem; 19 | 20 | PARM(2, CASE); 21 | aggr = vec_pop(env->stck); 22 | node = vec_back(env->stck); 23 | for (i = vec_size(aggr.u.lis) - 1; i >= 0; i--) { 24 | elem = vec_at(aggr.u.lis, i); 25 | if (!i) { 26 | node = elem; 27 | break; 28 | } 29 | if (!Compare(env, node, vec_back(elem.u.lis))) { 30 | vec_shallow_copy(node.u.lis, elem.u.lis); 31 | vec_reduce(node.u.lis, 1); 32 | vec_reduce(env->stck, 1); 33 | break; 34 | } 35 | } 36 | prog(env, node.u.lis); 37 | } 38 | #endif 39 | -------------------------------------------------------------------------------- /src/treestep.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : treestep.c 3 | version : 1.10 4 | date : 09/17/24 5 | */ 6 | #ifndef TREESTEP_C 7 | #define TREESTEP_C 8 | 9 | /** 10 | Q1 OK 2870 treestep : DDA T [P] -> ... 11 | Recursively traverses leaves of tree T, executes P for each leaf. 12 | */ 13 | void treestep_(pEnv env) 14 | { 15 | int i; 16 | Node list, node; 17 | vector(Node) *tree; 18 | 19 | PARM(2, DIP); 20 | list = vec_pop(env->stck); 21 | node = vec_pop(env->stck); 22 | vec_init(tree); 23 | for (i = vec_size(node.u.lis) - 1; i >= 0; i--) 24 | vec_push(tree, vec_at(node.u.lis, i)); 25 | while (vec_size(tree)) { 26 | node = vec_pop(tree); 27 | if (node.op == LIST_) 28 | for (i = vec_size(node.u.lis) - 1; i >= 0; i--) 29 | vec_push(tree, vec_at(node.u.lis, i)); 30 | else { 31 | prog(env, list.u.lis); 32 | prime(env, node); 33 | } 34 | } 35 | } 36 | #endif 37 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | # 2 | # module : makefile 3 | # version : 1.14 4 | # date : 12/16/24 5 | # 6 | .POSIX: 7 | .SUFFIXES: 8 | 9 | # Use CC environment variable 10 | # CC = gcc -pg 11 | CF = -O3 -Wall -Wextra -Wpedantic -Werror -Wno-unused-parameter 12 | LF = -lm -lgc 13 | CFLAGS = $(CF) -DCOMP="\"$(CF)\"" -DLINK="\"$(LF)\"" -DVERS="\"Release 1.0\"" 14 | HDRS = globals.h 15 | OBJS = main.o pars.o lexr.o arty.o eval.o exec.o module.o otab.o parm.o prog.o \ 16 | read.o repl.o save.o scan.o util.o writ.o xerr.o ylex.o print.o 17 | 18 | joy: prep $(OBJS) 19 | $(CC) -o$@ $(OBJS) $(LF) 20 | 21 | $(OBJECTS): $(HDRS) 22 | 23 | prep: 24 | sh prim.sh . 25 | sh tabl.sh . 26 | $(MAKE) pars.c 27 | 28 | clean: 29 | rm -f $(OBJS) pars.c pars.h lexr.c builtin.c builtin.h tabl.c 30 | 31 | .SUFFIXES: .c .o .y .l 32 | 33 | .c.o: 34 | $(CC) -o$@ $(CFLAGS) -c $< 35 | 36 | .y.c: 37 | bison -o$@ $< 38 | 39 | .l.c: 40 | flex -o$@ $< 41 | -------------------------------------------------------------------------------- /src/rest.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : rest.c 3 | version : 1.12 4 | date : 11/20/24 5 | */ 6 | #ifndef REST_C 7 | #define REST_C 8 | 9 | /** 10 | Q0 OK 2040 rest : DA A -> R 11 | R is the non-empty aggregate A with its first member removed. 12 | */ 13 | void rest_(pEnv env) 14 | { 15 | int i = 0; 16 | Node aggr, temp; 17 | 18 | PARM(1, FIRST); 19 | aggr = vec_pop(env->stck); 20 | switch (aggr.op) { 21 | case LIST_: 22 | vec_shallow_copy(temp.u.lis, aggr.u.lis); 23 | vec_reduce(temp.u.lis, 1); 24 | aggr.u.lis = temp.u.lis; 25 | break; 26 | 27 | case STRING_: 28 | case BIGNUM_: 29 | case USR_STRING_: 30 | aggr.u.str = GC_strdup(++aggr.u.str); 31 | break; 32 | 33 | case SET_: 34 | while (!(aggr.u.set & ((int64_t)1 << i))) 35 | i++; 36 | aggr.u.set &= ~((int64_t)1 << i); 37 | break; 38 | } 39 | vec_push(env->stck, aggr); 40 | } 41 | #endif 42 | -------------------------------------------------------------------------------- /src/__manual_list.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : __manual_list.c 3 | version : 1.13 4 | date : 09/17/24 5 | */ 6 | #ifndef __MANUAL_LIST_C 7 | #define __MANUAL_LIST_C 8 | 9 | /** 10 | Q0 OK 2960 __manual_list : A -> L 11 | Pushes a list L of lists (one per operator) of three documentation strings. 12 | */ 13 | void __manual_list_(pEnv env) 14 | { 15 | int i; 16 | Node node, temp, elem; 17 | 18 | vec_init(node.u.lis); 19 | node.op = temp.op = LIST_; 20 | elem.op = STRING_; 21 | for (i = sizeof(optable) / sizeof(optable[0]) - 1; i >= 0; i--) { 22 | vec_init(temp.u.lis); 23 | elem.u.str = optable[i].messg2; 24 | vec_push(temp.u.lis, elem); 25 | elem.u.str = optable[i].messg1; 26 | vec_push(temp.u.lis, elem); 27 | elem.u.str = optable[i].name; 28 | vec_push(temp.u.lis, elem); 29 | vec_push(node.u.lis, temp); 30 | } 31 | vec_push(env->stck, node); 32 | } 33 | #endif 34 | -------------------------------------------------------------------------------- /lib/jp-joytst.joy: -------------------------------------------------------------------------------- 1 | (* FILE: jp-joytst.joy - test file for jp-joyjoy.joy *) 2 | 3 | "jp-joyjoy" libload. (* R.W. *) 4 | 5 | 0 __settracegc. 6 | 1 setecho. 7 | (* testing the tracing versions of joy0: joy0s and joy0l *) 8 | 9 | 2 3 + "\nfinal answer = " putchars. 10 | 11 | [ 2 3 + ] joy0s "\nfinal answer = " putchars. 12 | 13 | [ [ 2 3 + ] joy0s ] joy0s "\nfinal answer = " putchars. 14 | 15 | [ [ [ 2 3 + ] joy0s ] joy0s ] joy0s "\nfinal answer = " putchars. 16 | 17 | [ 2 3 + ] joy0l "\nfinal answer = " putchars. 18 | 19 | [ [ 2 3 + ] joy0l ] joy0l "\nfinal answer = " putchars. 20 | 21 | [ [ [ 2 3 + ] joy0l ] joy0l ] joy0l "\nfinal answer = " putchars. 22 | 23 | (* and as a final absurdity, with no tracing at all: *) 24 | 25 | [[[[[ 2 3 +] joy0] joy0] joy0] joy0] joy0 "\nfinal answer = "putchars. 26 | 27 | (* END jp-joytst.joy *) 28 | -------------------------------------------------------------------------------- /src/assign.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : assign.c 3 | version : 1.5 4 | date : 09/17/24 5 | */ 6 | #ifndef ASSIGN_C 7 | #define ASSIGN_C 8 | 9 | /** 10 | Q0 IGNORE_POP 3140 assign : DD V [N] -> 11 | [IMPURE] Assigns value V to the variable with name N. 12 | */ 13 | void assign_(pEnv env) 14 | { 15 | Node node; 16 | int index; 17 | Entry ent; 18 | 19 | PARM(2, ASSIGN); /* quotation on top */ 20 | node = vec_pop(env->stck); /* singleton list */ 21 | node = vec_back(node.u.lis); /* first/last element */ 22 | index = node.u.ent; /* index user defined name */ 23 | ent = vec_at(env->symtab, index); /* symbol table entry */ 24 | node = vec_pop(env->stck); /* read value */ 25 | ent.is_user = 1; /* ensure again user defined */ 26 | vec_init(ent.u.body); /* (re)initialise body */ 27 | vec_push(ent.u.body, node); /* insert value in body */ 28 | vec_at(env->symtab, index) = ent; /* update symbol table */ 29 | } 30 | #endif 31 | -------------------------------------------------------------------------------- /src/cons.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : cons.c 3 | version : 1.13 4 | date : 12/13/24 5 | */ 6 | #ifndef CONS_C 7 | #define CONS_C 8 | 9 | /** 10 | Q0 OK 2010 cons : DDA X A -> B 11 | Aggregate B is A with a new member X (first member for sequences). 12 | */ 13 | void cons_(pEnv env) 14 | { 15 | Node aggr, elem, node; 16 | 17 | PARM(2, CONS); 18 | aggr = vec_pop(env->stck); 19 | elem = vec_pop(env->stck); 20 | switch (aggr.op) { 21 | case LIST_: 22 | vec_shallow_copy_take_ownership(node.u.lis, aggr.u.lis); 23 | vec_push(node.u.lis, elem); 24 | break; 25 | 26 | case STRING_: 27 | case BIGNUM_: 28 | case USR_STRING_: 29 | node.u.str = GC_malloc_atomic(strlen(aggr.u.str) + 2); 30 | node.u.str[0] = elem.u.num; 31 | strcpy(&node.u.str[1], aggr.u.str); 32 | break; 33 | 34 | case SET_: 35 | node.u.set = aggr.u.set | ((int64_t)1 << elem.u.num); 36 | break; 37 | } 38 | node.op = aggr.op; 39 | vec_push(env->stck, node); 40 | } 41 | #endif 42 | -------------------------------------------------------------------------------- /src/infra.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : infra.c 3 | version : 1.9 4 | date : 09/26/24 5 | */ 6 | #ifndef INFRA_C 7 | #define INFRA_C 8 | 9 | /** 10 | Q1 OK 2810 infra : DDA L1 [P] -> L2 11 | Using list L1 as stack, executes P and returns a new list L2. 12 | The first element of L1 is used as the top of stack, 13 | and after execution of P the top of stack becomes the first element of L2. 14 | */ 15 | void infra_(pEnv env) 16 | { 17 | Node list, aggr; 18 | 19 | PARM(2, INFRA); 20 | list = vec_pop(env->stck); 21 | aggr = vec_pop(env->stck); 22 | /* 23 | the old stack is saved in the program 24 | */ 25 | save(env, 0, 0, 0); 26 | /* 27 | after executing the program the stack is listed 28 | */ 29 | code(env, stack_); 30 | /* 31 | the program is executed on the alternate stack 32 | */ 33 | prog(env, list.u.lis); 34 | /* 35 | the list parameter is installed as the stack 36 | */ 37 | vec_copy_all(env->stck, aggr.u.lis); 38 | } 39 | #endif 40 | -------------------------------------------------------------------------------- /src/opcase.c: -------------------------------------------------------------------------------- 1 | /* 2 | module : opcase.c 3 | version : 1.11 4 | date : 11/20/24 5 | */ 6 | #ifndef OPCASE_C 7 | #define OPCASE_C 8 | 9 | /** 10 | Q0 OK 2090 opcase : DA X [..[X Xs]..] -> X [Xs] 11 | Indexing on type of X, returns the list [Xs]. 12 | */ 13 | void opcase_(pEnv env) 14 | { 15 | int i; 16 | Node aggr, node, elem, temp; 17 | 18 | PARM(2, CASE); 19 | aggr = vec_pop(env->stck); 20 | node = vec_back(env->stck); 21 | for (i = vec_size(aggr.u.lis) - 1; i >= 0; i--) { 22 | elem = vec_at(aggr.u.lis, i); 23 | if (!i) { 24 | node = elem; 25 | break; 26 | } 27 | temp = vec_back(elem.u.lis); 28 | if (node.op == temp.op) { 29 | if (node.op == ANON_FUNCT_) { 30 | if (node.u.proc != temp.u.proc) 31 | continue; 32 | } 33 | vec_shallow_copy(node.u.lis, elem.u.lis); 34 | vec_reduce(node.u.lis, 1); 35 | node.op = LIST_; 36 | break; 37 | } 38 | } 39 | vec_push(env->stck, node); 40 | } 41 | #endif 42 | --------------------------------------------------------------------------------