home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume13 / funcproglang / part01 next >
Encoding:
Internet Message Format  |  1988-01-30  |  29.6 KB
  1. Subject:  v13i014:  Functional programming language, Part01/02
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Andy Valencia <vandys@lindy.stanford.edu>
  7. Posting-number: Volume 13, Issue 14
  8. Archive-name: funcproglang/part01
  9.  
  10.  
  11. Enclosed is part 1 of a two-part shar implementing FP in C.
  12. It differs from the IFP recently posted in that it closely follows
  13. the syntax of the FP provided by 4.2 BSD (which is also the syntax used
  14. by Backus himself).  I think you'll want to tinker with the makefile
  15. a bit, but otherwise it shouldn't cause you any trouble--just compile
  16. and run.
  17.                 Thanks,
  18.                 Andy Valencia
  19.                 vandys@lindy.stanford.edu
  20. -----cut here-----cut here-----cut here-----cut here-----
  21. #!/bin/sh
  22. #    This is a shell archive.
  23. #    It contains fp.shar, 1/2
  24. #    Run the following text with /bin/sh to extract.
  25.  
  26. cat - << \Funky!Stuff! > Makefile
  27. #
  28. # Makefile for fp
  29. #
  30. #    Copyright (c) 1986 by Andy Valencia
  31. #
  32. # Compile-time options
  33. #    -DMEMSTAT to get run-time memory statitistics/checking
  34. #    -DYYDEBUG to get parser tracing
  35. DEFS=
  36. #
  37. # Name your math library here.  On the HP-9000/320, for instance, naming
  38. #    -l881 instead of -lm will use the 68881 coprocessor.
  39. #
  40. MathLibs= -lfpa -lm -lfpa
  41. #
  42. CFLAGS= -O $(DEFS)
  43. OBJS= y.tab.o symtab.o lex.o misc.o ast.o obj.o \
  44.     exec.o charfn.o intrin.o defun.o
  45. fp: $(OBJS)
  46.     cc -o fp $(CFLAGS) $(OBJS) $(MathLibs)
  47. y.tab.h y.tab.c: parse.y fp.h
  48.     yacc -d parse.y
  49. y.tab.o: y.tab.c
  50.     cc $(CFLAGS) -c y.tab.c
  51. lex.o: symtab.h lex.c y.tab.h
  52. symtab.o: symtab.c symtab.h fp.h y.tab.h
  53. ast.o: ast.c fp.h
  54. obj.o: obj.c fp.h
  55. exec.o: exec.c fp.h y.tab.h
  56. charfn.o: charfn.c fp.h y.tab.h
  57. instrinsics.o: instrinsics.c fp.h y.tab.h
  58. defun.o: defun.c symtab.h fp.h y.tab.h
  59. Funky!Stuff!
  60. cat - << \Funky!Stuff! > README
  61.  
  62.     This directory contains a C implementation of John Backus' "FP"
  63. language.  I wrote this over a period of time, so don't be too shocked by
  64. many repetitions of the same sequence of code.  The stuff has been written
  65. to run on HP-UX, which is mostly system V.  It handles signals using the
  66. "old" signal handler interface, which might offend some reliable signal buffs,
  67. but seemed to be compatible with more systems.
  68.  
  69.     Aside from signals it does absolutely nothing surprising, and is quite
  70. conscientious about declaring what it uses (even in the YACC file!).  It
  71. has ported to HP-UX on both RISC and 68K-family machines, and has also
  72. run on our 4.2 VAX.  "lint" is reasonably happy with it, but still complains
  73. about things like "printf() returns a value which is always ignored".  I
  74. haven't done anything about these sorts of complaints.  If you come
  75. across any unportable facet (within reason), I will be happy to change it.
  76.  
  77.     This code is completely original and wholly created by myself.  I
  78. release this code into the public domain without limitations or exceptions.
  79. You may use this code in whole or part for any purpose whatsoever, including
  80. commercial advantage.  If you wish to provide some payment for its use,
  81. give it to a charity of your choice instead.
  82.  
  83.     Many thanks to John Backus for his refreshing Turing award lecture,
  84. and to the many people who are working on non-Von Neumann languages and
  85. machine architectures.  Please get in touch with me if you are doing work
  86. in these areas!
  87.  
  88.                 Regards,
  89.                 Andy Valencia
  90.                 vandys@lindy.stanford.edu
  91.                 br.ajv@rlg.BITNET
  92.  
  93. The files and their contents are:
  94.  
  95. Makefile        System-V makefile
  96. _astprtr        Debugging routine to print the syntax tree
  97. ast.c            Routines to manage syntax tree nodes
  98. charfn.c        Routines to handle "char" functions, like '+'
  99. defun.c            Routines to handle user-defined functions
  100. exec.c            Top-level run-time driving functions
  101. fp.h            Central include file
  102. intrin.c        Execution of identifier-like functions, like "hd"
  103. lex.c            The lexical analyzer
  104. misc.c            Miscellaneous functions, like main() and fatal_err()
  105. obj.c            Functions to manage "object" nodes
  106. parse.y            A YACC parser for FP
  107. symtab.c        Symbol table handler
  108. symtab.h        Local declarations for symbol table
  109.  
  110. The following files contain sample FP programs:
  111.  
  112. bubsort.fp        Demo routine to do a bubble sort
  113. dft.fp            Discrete Fourier transform functions
  114. primes.fp        Prime number generator
  115. test.fp            My regression test file.  Won't run on UCB FP!
  116. Funky!Stuff!
  117. cat - << \Funky!Stuff! > _astprtr
  118. /*
  119.  * This file contains a routine for printing the parse tree.
  120.  *    It is useful when changing the syntax around.
  121.  *
  122.  *    Copyright (c) 1986 by Andy Valencia
  123.  */
  124.  
  125.     /*
  126.      * For debugging, print the parse tree
  127.      */
  128. void
  129. ast_prtree(p,d)
  130.     struct ast *p;
  131.     int d;
  132. {
  133.     int t = p->tag, x;
  134.  
  135.     if( !p ) return;
  136.     for( x = 1; x <= d; x++ ) putchar(' ');
  137.     printf("Tag '%c'",t);
  138.     switch( t ){
  139.     case 'c':{
  140.     int c = (p->val).YYint;
  141.  
  142.     printf(" operator '");
  143.     if( (c >= ' ') && (c < 127) )
  144.         putchar(c);
  145.     else switch( c ){
  146.     case NE: printf("NE"); break;
  147.     case LE: printf("<="); break;
  148.     case GE: printf(">="); break;
  149.     default: printf("???"); break;
  150.     }
  151.     printf("'\n");
  152.     break;
  153.     }
  154.     case 'S':
  155.     printf(" value %d\n",(p->val).YYint);
  156.     break;
  157.     case 'I':
  158.     printf(" value %d\n",(p->val).YYint);
  159.     break;
  160.     case 'F':
  161.     printf(" value %g\n",(p->val).YYfloat);
  162.     break;
  163.     case 'B':
  164.     printf(" boolean %s\n",(p->val).YYint ? "T" : "F");
  165.     break;
  166.     case 'i':
  167.     printf(" intrinsic name '%s'\n",((p->val).YYsym)->sym_pname);
  168.     break;
  169.     case 'L': {
  170.     putchar('\n');
  171.     while( p ){
  172.         ast_prtree(p->left,d+1);
  173.         p = p->right;
  174.     }
  175.     break;
  176.     }
  177.     case '[': {
  178.     struct ast *q = p->left;
  179.  
  180.     putchar('\n');
  181.     while( q ){
  182.         ast_prtree(q->left,d+1);
  183.         q = q->right;
  184.     }
  185.     break;
  186.     }
  187.     default:
  188.     putchar('\n');
  189.     ast_prtree(p->left,d+1);
  190.     ast_prtree(p->middle,d+1);
  191.     ast_prtree(p->right,d+1);
  192.     break;
  193.     }
  194. }
  195. Funky!Stuff!
  196. cat - << \Funky!Stuff! > ast.c
  197. /*
  198.  * Routines for allocating & freeing AST nodes
  199.  *
  200.  *    Copyright (c) 1986 by Andy Valencia
  201.  */
  202. #include "fp.h"
  203. #include "y.tab.h"
  204.  
  205. static struct ast *ast_list = 0;
  206.  
  207. #ifdef MEMSTAT
  208. int ast_out = 0;
  209. #endif
  210.  
  211.     /*
  212.      * Get a node
  213.      */
  214. struct ast *
  215. ast_alloc(atag,l,m,r)
  216.     int atag;
  217.     struct ast *l, *m, *r;
  218. {
  219.     register struct ast *p;
  220.  
  221. #ifdef MEMSTAT
  222.     ast_out++;
  223. #endif
  224.     if( p = ast_list ){
  225.     ast_list = p->left;
  226.     } else {
  227.     p = (struct ast *)malloc(sizeof(struct ast));
  228.     }
  229.     if( p == 0 ) fatal_err("Out of mem in ast_alloc()");
  230.     p->tag = atag;
  231.     p->left = l;
  232.     p->middle = m;
  233.     p->right = r;
  234.     return( p );
  235. }
  236.  
  237.     /*
  238.      * Free a node
  239.      */
  240. void
  241. ast_free(p)
  242.     register struct ast *p;
  243. {
  244. #ifdef MEMSTAT
  245.     ast_out--;
  246. #endif
  247.     if( !p ) fatal_err("NULL node in ast_free()");
  248.     p->left = ast_list;
  249.     ast_list = p;
  250. }
  251.  
  252.     /*
  253.      * Free a whole tree
  254.      */
  255. void
  256. ast_freetree(p)
  257.     struct ast *p;
  258. {
  259.     if( !p ) return;
  260.     ast_freetree(p->left);
  261.     ast_freetree(p->right);
  262.     ast_freetree(p->middle);
  263.     if( p->tag == '%' )
  264.     obj_unref( (p->val).YYobj );
  265.     ast_free(p);
  266. }
  267. Funky!Stuff!
  268. cat - << \Funky!Stuff! > bsort.fp
  269. #
  270. # A divide-and-conquer sorting algorithm
  271. #
  272. {grpleft
  273.     concat @ &( > -> tl ; %<>) @ distl }
  274. {grpright
  275.     concat @ &( < -> tl ; %<>) @ distl }
  276. {arb 1}
  277. {bsort
  278.     (>@[length %1] ->
  279.     concat@[bsort@grpleft [1] bsort@grpright]@[arb id]
  280.     ; id)
  281. }
  282. Funky!Stuff!
  283. cat - << \Funky!Stuff! > bubsort.fp
  284. {swap concat@[ [2,1],tl@tl ]}
  285. {step (>@[1,2] -> swap ; id) }
  286. {pass
  287.     (<@[length,%2] -> id ;
  288.     apndl@[1,pass@tl]@step)
  289. }
  290. {bubsort
  291.     (<@[length,%2] -> id ;
  292.     apndr@[bubsort@tlr,last]@pass)
  293. }
  294. Funky!Stuff!
  295. cat - << \Funky!Stuff! > charfn.c
  296. /*
  297.  * charfn.c--functions to do the "character" functions, like +, -, ...
  298.  *
  299.  *     Copyright (c) 1986 by Andy Valencia
  300.  */
  301. #include "fp.h"
  302. #include "y.tab.h"
  303.  
  304.     /*
  305.      * This ugly set of macros makes access to objects easier.
  306.      *
  307.      * UNDEFINED generates the undefined object & returns it
  308.      * NUMVAL generates a value for C of the correct type
  309.      * CAR manipulates the object as a list & gives its first part
  310.      * CDR is like CAR but gives all but the first
  311.      * ISNUM provides a boolean saying if the named object is a number
  312.      */
  313. #define UNDEFINED return(obj_alloc(T_UNDEF));
  314. #define NUMVAL(x) ( (x->o_type == T_INT) ? \
  315.     ((x->o_val).o_int) : ((x->o_val).o_double) )
  316. #define CAR(x) ( (x->o_val).o_list.car )
  317. #define CDR(x) ( (x->o_val).o_list.cdr )
  318. #define ISNUM(x) ( (x->o_type == T_INT) || (x->o_type == T_FLOAT) )
  319.  
  320. int numargs();
  321.  
  322.     /*
  323.      * same()--looks at two objects and tells whether they are the same.
  324.      *    We recurse if it is a list.
  325.      */
  326. static
  327. same( o1, o2 )
  328.     register struct object *o1, *o2;
  329. {
  330.     if( o1 == o2 ) return( 1 );
  331.     if( o1->o_type != o2->o_type ){
  332.     if( o1->o_type == T_INT )
  333.         if( o2->o_type == T_FLOAT )
  334.         return( o1->o_val.o_int == o2->o_val.o_double );
  335.     if( o2->o_type == T_INT )
  336.         if( o1->o_type == T_FLOAT )
  337.         return( o2->o_val.o_int == o1->o_val.o_double );
  338.     return( 0 );
  339.     }
  340.     switch( o1->o_type ){
  341.     case T_INT:
  342.     case T_BOOL:
  343.     return( o1->o_val.o_int == o2->o_val.o_int );
  344.     case T_FLOAT:
  345.     return( o1->o_val.o_double == o2->o_val.o_double );
  346.     case T_LIST:
  347.     return( same(CAR(o1),CAR(o2)) && same(CDR(o1),CDR(o2)) );
  348.     default:
  349.     fatal_err("Bad AST type in same()");
  350.     }
  351.     /*NOTREACHED*/
  352. }
  353.  
  354.     /*
  355.      * ispair()--tell if our argument object is a list of two elements
  356.      */
  357. static
  358. ispair(obj)
  359.     register struct object *obj;
  360. {
  361.     if( obj->o_type != T_LIST ) return( 0 );
  362.     if( CAR(obj) == 0 ) return( 0 );
  363.     if( CDR(obj) == 0 ) return( 0 );
  364.     if( CDR(CDR(obj)) ) return( 0 );
  365.     return( 1 );
  366. }
  367.  
  368.     /*
  369.      * eqobj()--tell if the two objects in the list are equal.
  370.      *    undefined on ill-formed list, etc.
  371.      */
  372. struct object *
  373. eqobj(obj)
  374.     struct object *obj;
  375. {
  376.     struct object *p;
  377.  
  378.     if( !ispair(obj) ){
  379.     obj_unref(obj);
  380.     UNDEFINED;
  381.     }
  382.     p = obj_alloc(T_BOOL);
  383.     if( same(CAR(obj),CAR(CDR(obj))) )
  384.     p->o_val.o_int = 1;
  385.     else
  386.     p->o_val.o_int = 0;
  387.     obj_unref(obj);
  388.     return(p);
  389. }
  390.  
  391.     /*
  392.      * noteqobj()--just like eqobj(), but not equal
  393.      */
  394. static struct object *
  395. noteqobj(obj)
  396.     struct object *obj;
  397. {
  398.     struct object *p = eqobj(obj);
  399.  
  400.     if( p->o_type == T_BOOL )
  401.     p->o_val.o_int = (p->o_val.o_int ? 0 : 1);
  402.     return(p);
  403. }
  404.  
  405.     /*
  406.      * do_charfun()--execute the action of a binary function
  407.      */
  408. struct object *
  409. do_charfun(act,obj)
  410.     struct ast *act;
  411.     register struct object *obj;
  412. {
  413.     register struct object *p;
  414.     double f;
  415.  
  416.     switch( (act->val).YYint ){
  417.  
  418.     case '=':
  419.     return( eqobj(obj) );
  420.     case NE:
  421.     return( noteqobj(obj) );
  422.  
  423.     case '>':
  424.     switch( numargs(obj) ){
  425.     case T_UNDEF:
  426.         obj_unref(obj);
  427.         UNDEFINED;
  428.     case T_FLOAT:
  429.     case T_INT:
  430.         p = obj_alloc(T_BOOL);
  431.         (p->o_val).o_int = NUMVAL(CAR(obj)) > NUMVAL(CAR(CDR(obj)));
  432.         obj_unref(obj);
  433.         return(p);
  434.     }
  435.  
  436.     case GE:
  437.     switch( numargs(obj) ){
  438.     case T_UNDEF:
  439.         obj_unref(obj);
  440.         UNDEFINED;
  441.     case T_FLOAT:
  442.     case T_INT:
  443.         p = obj_alloc(T_BOOL);
  444.         (p->o_val).o_int = NUMVAL(CAR(obj)) >= NUMVAL(CAR(CDR(obj)));
  445.         obj_unref(obj);
  446.         return(p);
  447.     }
  448.  
  449.     case LE:
  450.     switch( numargs(obj) ){
  451.     case T_UNDEF:
  452.         obj_unref(obj);
  453.         UNDEFINED;
  454.     case T_FLOAT:
  455.     case T_INT:
  456.         p = obj_alloc(T_BOOL);
  457.         (p->o_val).o_int = NUMVAL(CAR(obj)) <= NUMVAL(CAR(CDR(obj)));
  458.         obj_unref(obj);
  459.         return(p);
  460.     }
  461.  
  462.     case '<':
  463.     switch( numargs(obj) ){
  464.     case T_UNDEF:
  465.         obj_unref(obj);
  466.         UNDEFINED;
  467.     case T_FLOAT:
  468.     case T_INT:
  469.         p = obj_alloc(T_BOOL);
  470.         (p->o_val).o_int = NUMVAL(CAR(obj)) < NUMVAL(CAR(CDR(obj)));
  471.         obj_unref(obj);
  472.         return(p);
  473.     }
  474.  
  475.     case '+':
  476.     switch( numargs(obj) ){
  477.     case T_UNDEF:
  478.         obj_unref(obj);
  479.         UNDEFINED;
  480.     case T_FLOAT:
  481.         p = obj_alloc(T_FLOAT);
  482.         (p->o_val).o_double = NUMVAL(CAR(obj))+NUMVAL(CAR(CDR(obj)));
  483.         obj_unref(obj);
  484.         return(p);
  485.     case T_INT:
  486.         p = obj_alloc(T_INT);
  487.         (p->o_val).o_int = NUMVAL(CAR(obj))+NUMVAL(CAR(CDR(obj)));
  488.         obj_unref(obj);
  489.         return(p);
  490.     }
  491.     case '-':
  492.     switch( numargs(obj) ){
  493.     case T_UNDEF:
  494.         obj_unref(obj);
  495.         UNDEFINED;
  496.     case T_FLOAT:
  497.         p = obj_alloc(T_FLOAT);
  498.         (p->o_val).o_double = NUMVAL(CAR(obj))-NUMVAL(CAR(CDR(obj)));
  499.         obj_unref(obj);
  500.         return(p);
  501.     case T_INT:
  502.         p = obj_alloc(T_INT);
  503.         (p->o_val).o_int = NUMVAL(CAR(obj))-NUMVAL(CAR(CDR(obj)));
  504.         obj_unref(obj);
  505.         return(p);
  506.     }
  507.     case '*':
  508.     switch( numargs(obj) ){
  509.     case T_UNDEF:
  510.         obj_unref(obj);
  511.         UNDEFINED;
  512.     case T_FLOAT:
  513.         p = obj_alloc(T_FLOAT);
  514.         (p->o_val).o_double = NUMVAL(CAR(obj))*NUMVAL(CAR(CDR(obj)));
  515.         obj_unref(obj);
  516.         return(p);
  517.     case T_INT:
  518.         p = obj_alloc(T_INT);
  519.         (p->o_val).o_int = NUMVAL(CAR(obj))*NUMVAL(CAR(CDR(obj)));
  520.         obj_unref(obj);
  521.         return(p);
  522.     }
  523.     case '/':
  524.     switch( numargs(obj) ){
  525.     case T_UNDEF:
  526.         obj_unref(obj);
  527.         UNDEFINED;
  528.     case T_FLOAT:
  529.     case T_INT:
  530.         f = NUMVAL(CAR(CDR(obj)));
  531.         if( f == 0.0 ){
  532.         obj_unref(obj);
  533.         UNDEFINED;
  534.         }
  535.         p = obj_alloc(T_FLOAT);
  536.         (p->o_val).o_double = NUMVAL(CAR(obj))/f;
  537.         obj_unref(obj);
  538.         return(p);
  539.     }
  540.     default:
  541.     fatal_err("Undefined charop tag in execute()");
  542.     }
  543.     /*NOTREACHED*/
  544. }
  545.  
  546.     /*
  547.      * numargs()--process a list which is to be used as a pair of numeric
  548.      *    arguments to a function.
  549.      *
  550.      *    +, -, /, etc.  all need two functions:  first, they need to know
  551.      *    if their arguments are OK.  Is it a list, are there two
  552.      *    numbers in it?, etc.  We make C normalize the two numbers, but
  553.      *    we tell our caller if the result will be double or int, so that he
  554.      *    can allocate the right type of object.
  555.      */
  556. numargs(obj)
  557.     register struct object *obj;
  558. {
  559.     register struct object *p, *q;
  560.  
  561.     /*
  562.      * Don't have a well-formed list, so illegal
  563.      */
  564.     if( !ispair(obj) ) return(T_UNDEF);
  565.  
  566.     /*
  567.      * So it's a list of two.  Verify type of both elements.
  568.      *    'p' gets the first object, 'q' gets second.
  569.      */
  570.     p = CAR(obj);
  571.     q = CAR(CDR(obj));
  572.     if( !ISNUM(p) || !ISNUM(q) ) return(T_UNDEF);
  573.     if( (p->o_type == T_FLOAT) || (q->o_type == T_FLOAT) )
  574.     return(T_FLOAT);
  575.     return(T_INT);
  576. }
  577. Funky!Stuff!
  578. cat - << \Funky!Stuff! > defun.c
  579. /*
  580.  * defun.c--define a user function
  581.  *
  582.  *    Copyright (c) 1986 by Andy Valencia
  583.  */
  584. #include "symtab.h"
  585.  
  586.     /*
  587.      * Define a function
  588.      */
  589. void
  590. defun(name,def)
  591.     register struct symtab *name;
  592.     struct ast *def;
  593. {
  594.     /*
  595.      * Check what we're defining, handle redefining
  596.      */
  597.     switch( name->sym_type ){
  598.     case SYM_DEF:
  599.     printf("%s: redefined.\n",name->sym_pname);
  600.     ast_freetree(name->sym_val.YYast);
  601.     break;
  602.     case SYM_NEW:
  603.     printf("{%s}\n",name->sym_pname);
  604.     break;
  605.     default:
  606.     fatal_err("Bad symbol stat in defun()");
  607.     }
  608.  
  609.     /*
  610.      * Mark symbol as a user-defined function, attach its
  611.      *    definition.
  612.      */
  613.     name->sym_val.YYast = def;
  614.     name->sym_type = SYM_DEF;
  615. }
  616.  
  617.     /*
  618.      * Call a previously-defined user function, or error
  619.      */
  620. struct object *
  621. invoke( def, obj )
  622.     register struct symtab *def;
  623.     struct object *obj;
  624. {
  625.     /*
  626.      * Must be a defined function
  627.      */
  628.     if( def->sym_type != SYM_DEF ){
  629.     printf("%s: undefined\n",def->sym_pname);
  630.     obj_unref(obj);
  631.     return( obj_alloc(T_UNDEF) );
  632.     }
  633.  
  634.     /*
  635.      * Call it with the object
  636.      */
  637.     return( execute( def->sym_val.YYast, obj ) );
  638. }
  639. Funky!Stuff!
  640. cat - << \Funky!Stuff! > dft.fp
  641. # Discrete Fourier Transform
  642. # Usage: dft : b
  643. # Where "b" is the input vector
  644.  
  645. {pi      %3.141592653589793}
  646.  
  647. {wN    1}
  648. {p    2}
  649. {r    2}
  650. {B    1}
  651.  
  652. {realCDiv    &/ @ distr @ reverse}
  653.  
  654. {distMult &* @ distl}
  655.  
  656. {iota0    apndl @ [%0,
  657.          iota @ - @ [id,%1]
  658.         ]
  659. }
  660.  
  661. {oddp    = @  [%1 , mod @ [id,%2]]}
  662.  
  663. {cAdd        &+ @ trans}
  664.        
  665. {reCxIp    !cAdd @ &&* @ &distl @ trans}
  666.  
  667. {cExp    [cos , sin]}
  668.  
  669. {N     length @ 1}
  670.  
  671. {w     cExp @  / @ [!* @  [%-2, pi, p],
  672.              wN
  673.             ]
  674. }
  675.  
  676. {ws     cExp @  + @ [pi,
  677.              / @ [!* @  [%-2, pi, p],
  678.                     wN
  679.                    ]
  680.             ]
  681.  
  682. }
  683.  
  684.  
  685. {wFactors    &(oddp @ 3 ->
  686.                ws @ [1,* @ tl];
  687.                w  @ [1,* @ tl]) @
  688.         &apndl @ 
  689.         distl @
  690.         [N,
  691.          distl @ [r, iota0 @ N]
  692.         ]
  693. }
  694.  
  695.  
  696.  
  697.  
  698.  
  699. {dftPt    realCDiv  @  [N,
  700.              reCxIp @ [B, wFactors]
  701.              ]
  702. }
  703.   
  704. {dft    &dftPt @ distl @ [id,iota0 @ length]}
  705.  
  706. {b %<1.0, 2.0, 3.0, 4.0, 3.0, 2.0, 1.0, 0.5>}
  707.  
  708. {d %<0.0, 0.5, 1.0, 1.0>}
  709.  
  710. {e %<
  711. 1.0, 2.0, 3.0, 4.0, 3.0, 2.0, 1.0, 0.5, 1.0, 2.0, 3.0, 4.0, 3.0, 2.0, 1.0, 0.5,
  712. 1.0, 2.0, 3.0, 4.0, 3.0, 2.0, 1.0, 0.5, 1.0, 2.0, 3.0, 4.0, 3.0, 2.0, 1.0, 0.5>}
  713.  
  714. Funky!Stuff!
  715. cat - << \Funky!Stuff! > fp.h
  716. /*
  717.  * Common definitions for FP
  718.  *
  719.  *    Copyright (c) 1986 by Andy Valencia
  720.  */
  721.  
  722.     /*
  723.      * Aliases for unsigned quantities.  Not really any reason, just
  724.      *    couldn't resist wasting a bit...
  725.      */
  726. typedef unsigned char uchar;
  727. typedef unsigned long int uint;
  728.  
  729.     /*
  730.      * The symbolic names for the different types
  731.      */
  732. #define T_INT 1        /* Integer */
  733. #define T_FLOAT 2    /* Floating point */
  734. #define T_LIST 3    /* A LISP-style list */
  735. #define T_UNDEF 4    /* The undefined object */
  736. #define T_BOOL 5    /* A boolean value */
  737.  
  738.     /*
  739.      * A list of arbitrary objects
  740.      */
  741. struct list {
  742.     struct object
  743.     *car,        /* Head of list */
  744.     *cdr;        /* and Tail */
  745. };
  746.  
  747.     /*
  748.      * An object's structure
  749.      */
  750. struct object {
  751.     uchar o_type;        /* Type for selecting */
  752.     uint o_refs;        /* Number of current refs, for GC */
  753.     union {
  754.     int o_int;        /* T_INT, T_BOOL */
  755.     double o_double;        /* T_FLOAT */
  756.     struct list o_list;    /* T_LIST */
  757.     } o_val;
  758. };
  759.  
  760. extern struct ast *ast_alloc();
  761. extern struct object *obj_alloc(), *execute(), *invoke();
  762. extern void ast_free(), ast_freetree(), fatal_err(), defun(),
  763.     symtab_init(), obj_free(), obj_unref(), obj_prtree();
  764. extern char *malloc();
  765. extern struct symtab *lookup();
  766.  
  767.  
  768.     /*
  769.      * To alleviate typing in YACC, this type embodies all the
  770.      *    types which "yylval" might receive.
  771.      */
  772. typedef union {
  773.     int YYint;
  774.     double YYdouble;
  775.     struct ast *YYast;
  776.     struct object *YYobj;
  777.     struct list *YYlist;
  778.     struct symtab *YYsym;
  779. } YYstype;
  780. #define YYSTYPE YYstype
  781.  
  782.     /*
  783.      * An AST
  784.      */
  785. struct ast {
  786.     int tag;
  787.     YYSTYPE val;
  788.     struct ast *left, *middle, *right;
  789. };
  790.  
  791.     /*
  792.      * A symbol table entry for an identifier
  793.      */
  794. struct symtab {
  795.     uchar sym_type;
  796.     YYstype sym_val;
  797.     struct symtab *sym_next;
  798.     char *sym_pname;
  799. };
  800.  
  801. Funky!Stuff!
  802. cat - << \Funky!Stuff! > misc.c
  803. /*
  804.  * Miscellaneous functions
  805.  *
  806.  *    Copyright (c) 1986 by Andy Valencia
  807.  */
  808. #include "fp.h"
  809. #include <setjmp.h>
  810. #include <signal.h>
  811.  
  812. extern void exit(), longjmp();
  813. extern char prompt;
  814.  
  815. static jmp_buf restart;
  816.  
  817. void
  818. fatal_err(msg)
  819.     char *msg;
  820. {
  821.     printf("Fatal error: %s\n",msg);
  822.     exit( 1 );
  823. }
  824.  
  825. yyerror(msg)
  826.     char *msg;
  827. {
  828.     printf("yyerror() reports '%s'\n",msg);
  829.     prompt = '\t';
  830. }
  831.  
  832.     /*
  833.      * Floating exception handler
  834.      */
  835. static void
  836. badmath(){
  837.     printf("Floating exception\n");
  838.     prompt = '\t';
  839.     signal(SIGFPE, badmath);
  840.     longjmp(restart,1);
  841. }
  842.  
  843.     /*
  844.      * User interrupt handler
  845.      */
  846. static void
  847. intr(){
  848.     printf("Interrupt\n");
  849.     prompt = '\t';
  850.     signal(SIGINT, intr);
  851.     longjmp(restart,1);
  852. }
  853.  
  854. main() {
  855.     symtab_init();
  856.     prompt = '\t';
  857.  
  858.     signal(SIGFPE, badmath);
  859.     signal(SIGINT, intr);
  860.  
  861.     if( setjmp(restart) == 0 )
  862.     printf("FP v0.0\n");
  863.     else
  864.     printf("FP restarted\n");
  865.     yyparse();
  866.     printf("\nFP done\n");
  867.     exit( 0 );
  868.     /*NOTREACHED*/
  869. }
  870. Funky!Stuff!
  871. cat - << \Funky!Stuff! > parse.y
  872. %{
  873.    /*
  874.     * FP syntax for YACC
  875.     *
  876.     *    Copyright (c) 1986 by Andy Valencia
  877.     */
  878. #include "fp.h"
  879.  
  880. #define NULLAST ((struct ast *)0)
  881. extern char prompt;
  882. static char had_undef = 0;
  883. extern void fp_cmd();
  884.  
  885. #ifdef MEMSTAT
  886. extern int obj_out, ast_out;
  887. #endif
  888. %}
  889.  
  890. %start go
  891.  
  892. %token INT FLOAT T F ID UDEF AND OR XOR NE GT LT GE LE
  893. %token SIN COS TAN ASIN ACOS ATAN LOG EXP MOD CONCAT LAST FIRST PICK
  894. %token TL HD ATOM NOT EQ NIL REVERSE DISTL DISTR LENGTH DIV
  895. %token TRANS APNDL APNDR TLR ROTL ROTR IOTA PAIR SPLIT OUT
  896. %token FRONT
  897.  
  898. %token WHILE
  899. %token '[' ']'
  900. %right '@'
  901. %right '%' '!' '&' '|'
  902.  
  903. %%
  904. go    :    go fpInput
  905.     |    go error
  906.             { yyclearin; }
  907.     |    Empty
  908.     ;
  909.  
  910. fpInput
  911.     :    fnDef
  912.             {
  913. #ifdef MEMSTAT
  914.     if( obj_out || ast_out ){
  915.     printf("%d objects and %d AST nodes used in definition\n",
  916.       obj_out,ast_out);
  917.     obj_out = ast_out = 0;
  918.     }
  919. #endif
  920.             }
  921.     |    application
  922.             {
  923. #ifdef MEMSTAT
  924.     if( obj_out || ast_out ){
  925.     printf("%d objects lost, %d AST nodes lost\n",obj_out,ast_out);
  926.     obj_out = ast_out = 0;
  927.     }
  928. #endif
  929.             }
  930.     |    ')'
  931.             { fp_cmd(); }
  932.     ;
  933.  
  934. fnDef    :    '{'
  935.             { prompt = '>'; }
  936.         name funForm
  937.         '}'
  938.             {
  939.             defun($3.YYsym,$4.YYast);
  940.             prompt = '\t';
  941.             }
  942.     ;
  943.  
  944. application
  945.     :        { prompt = '-'; }
  946.         funForm ':' object
  947.             {
  948.             struct object *p = execute($2.YYast,$4.YYobj);
  949.  
  950.             obj_prtree(p);
  951.             printf("\n");
  952.             obj_unref(p);
  953.             ast_freetree($2.YYast);
  954.             prompt = '\t';
  955.             }
  956.     ;
  957.  
  958. name    :    UDEF
  959.     ;
  960.  
  961. object    :    object2
  962.             {
  963.                 /*
  964.                  * If the luser, say, makes <1 2 <3 ?>>,
  965.                  *    we need to flatten it to ?.
  966.                  */
  967.             if( had_undef ){
  968.                 obj_unref($1.YYobj);
  969.                 $$.YYobj = obj_alloc(T_UNDEF);
  970.                 had_undef = 0;
  971.             }
  972.             }
  973.     ;
  974. object2    :    atom
  975.     |    fpSequence
  976.     |    '?'
  977.             {
  978.             $$.YYobj = obj_alloc(T_UNDEF);
  979.             had_undef = 1;
  980.             }
  981.     ;
  982.  
  983. fpSequence
  984.     :    '<' object2 OptComma SeqBody '>'
  985.             {
  986.             struct object *p = 
  987.                 $$.YYobj = obj_alloc(T_LIST);
  988.             (p->o_val).o_list.car = $2.YYobj;
  989.             (p->o_val).o_list.cdr = $4.YYobj;
  990.             }
  991.     ;
  992. SeqBody    :    Empty
  993.             {
  994.             $$.YYobj = 0;
  995.             }
  996.     |    object2 OptComma SeqBody
  997.             {
  998.             struct object *p = 
  999.                 $$.YYobj = obj_alloc(T_LIST);
  1000.             (p->o_val).o_list.car = $1.YYobj;
  1001.             (p->o_val).o_list.cdr = $3.YYobj;
  1002.             }
  1003.     ;
  1004.  
  1005. atom    :    T
  1006.             {
  1007.             struct object *p = 
  1008.                 $$.YYobj = obj_alloc(T_BOOL);
  1009.             (p->o_val).o_int = 1;
  1010.             }
  1011.     |    F
  1012.             {
  1013.             struct object *p = 
  1014.                 $$.YYobj = obj_alloc(T_BOOL);
  1015.             (p->o_val).o_int = 0;
  1016.             }
  1017.     |    '<' '>'
  1018.             {
  1019.             struct object *p = 
  1020.                 $$.YYobj = obj_alloc(T_LIST);
  1021.             (p->o_val).o_list.car =
  1022.                 (p->o_val).o_list.cdr = 0;
  1023.             }
  1024.     |    INT
  1025.             {
  1026.             struct object *p = 
  1027.                 $$.YYobj = obj_alloc(T_INT);
  1028.             (p->o_val).o_int = $1.YYint;
  1029.             }
  1030.     |    FLOAT
  1031.             {
  1032.             struct object *p = 
  1033.                 $$.YYobj = obj_alloc(T_FLOAT);
  1034.             (p->o_val).o_double = $1.YYdouble;
  1035.             }
  1036.     ;
  1037.  
  1038. funForm    :    simpFn
  1039.     |    composition
  1040.     |    construction
  1041.     |    conditional
  1042.     |    constantFn
  1043.     |    insertion
  1044.     |    alpha
  1045.     |    While
  1046.     |    '(' funForm ')'
  1047.             {
  1048.             $$ = $2;
  1049.             }
  1050.     ;
  1051.  
  1052. simpFn    :    IdFns
  1053.             {
  1054.             $$.YYast = ast_alloc('i', NULLAST, NULLAST, NULLAST);
  1055.             (($$.YYast)->val).YYsym = $1.YYsym;
  1056.             }
  1057.     |    INT
  1058.             {
  1059.             $$.YYast = ast_alloc('S', NULLAST, NULLAST, NULLAST);
  1060.             (($$.YYast)->val).YYint = $1.YYint;
  1061.             }
  1062.     |    binaryFn
  1063.             {
  1064.             $$.YYast = ast_alloc('c', NULLAST, NULLAST, NULLAST);
  1065.             (($$.YYast)->val).YYint = $1.YYint;
  1066.             }
  1067.     |    name
  1068.             {
  1069.             $$.YYast = ast_alloc('U', NULLAST, NULLAST, NULLAST);
  1070.             (($$.YYast)->val).YYsym = $1.YYsym;
  1071.             }
  1072.     ;
  1073.  
  1074. IdFns
  1075.     :    TL
  1076.     |    DIV
  1077.     |    HD
  1078.     |    EQ
  1079.     |    ATOM
  1080.     |    PICK
  1081.     |    NOT
  1082.     |    NIL
  1083.     |    REVERSE
  1084.     |    DISTL
  1085.     |    DISTR
  1086.     |    LENGTH
  1087.     |    TRANS
  1088.     |    APNDL
  1089.     |    APNDR
  1090.     |    TLR
  1091.     |    FRONT
  1092.     |    ROTL
  1093.     |    ROTR
  1094.     |    IOTA
  1095.     |    PAIR
  1096.     |    SPLIT
  1097.     |    CONCAT
  1098.     |    LAST
  1099.     |    FIRST
  1100.     |    OUT
  1101.     |    SIN
  1102.     |    COS
  1103.     |    TAN
  1104.     |    ASIN
  1105.     |    ACOS
  1106.     |    ATAN
  1107.     |    LOG
  1108.     |    EXP
  1109.     |    MOD
  1110.     |    OR
  1111.     |    AND
  1112.     |    XOR
  1113.     |    ID
  1114.     ;
  1115.  
  1116. binaryFn
  1117.     :    '<'
  1118.     |    '>'
  1119.     |    '='
  1120.     |    GE
  1121.     |    LE
  1122.     |    NE
  1123.     |    '+'
  1124.     |    '-'
  1125.     |    '*'
  1126.     |    '/'
  1127.     ;
  1128.  
  1129. composition
  1130.     :    funForm '@' funForm
  1131.             {
  1132.             $$.YYast = ast_alloc('@',$1.YYast,NULLAST,$3.YYast);
  1133.             }
  1134.     ;
  1135.  
  1136. construction
  1137.     :    '[' formList ']'
  1138.             {
  1139.             $$.YYast = ast_alloc('[',$2.YYast,NULLAST,NULLAST);
  1140.             }
  1141.     ;
  1142.  
  1143. formList
  1144.     :    funForm
  1145.             {
  1146.             $$.YYast = ast_alloc('[',$1.YYast,NULLAST,NULLAST);
  1147.             }
  1148.     |    funForm OptComma formList
  1149.             {
  1150.             $$.YYast = ast_alloc('[',$1.YYast,NULLAST,$3.YYast);
  1151.             }
  1152.     ;
  1153.  
  1154. conditional
  1155.     :    '(' funForm '-' '>' funForm ';' funForm ')'
  1156.             {
  1157.             $$.YYast = ast_alloc('>',$2.YYast,$5.YYast,$7.YYast);
  1158.             }
  1159.     ;
  1160.  
  1161. constantFn
  1162.     :    '%' object
  1163.             {
  1164.             $$.YYast = ast_alloc('%',NULLAST,NULLAST,NULLAST);
  1165.             (($$.YYast)->val).YYobj = $2.YYobj;
  1166.             }
  1167.     ;
  1168.  
  1169. insertion
  1170.     :    '!' funForm
  1171.             {
  1172.             $$.YYast = ast_alloc('!',$2.YYast,NULLAST,NULLAST);
  1173.             }
  1174.     |    '|' funForm
  1175.             {
  1176.             $$.YYast = ast_alloc('|',$2.YYast,NULLAST,NULLAST);
  1177.             }
  1178.     ;
  1179.  
  1180. alpha    :    '&' funForm
  1181.             {
  1182.             $$.YYast = ast_alloc('&',$2.YYast,NULLAST,NULLAST);
  1183.             }
  1184.     ;
  1185.  
  1186. While    :    '(' WHILE funForm funForm ')'
  1187.             {
  1188.             $$.YYast = ast_alloc('W',$3.YYast,NULLAST,$4.YYast);
  1189.             }
  1190.     ;
  1191.  
  1192. Empty    :    /* Nothing */
  1193.     ;
  1194.  
  1195. OptComma            /* Optional comma */
  1196.     :    Empty
  1197.     |    ','
  1198.     ;
  1199. %%
  1200. Funky!Stuff!
  1201. cat - << \Funky!Stuff! > primes.fp
  1202. #
  1203. # Print prime numbers from 3 to ?
  1204. #
  1205. {factors
  1206.     &(+@[id %1]@*@[id %2])@iota@div@[id %4]
  1207. }
  1208. {isprime
  1209.     |and@&(~=@[id %0])@&mod@distl@[id factors]
  1210. }
  1211. {primes
  1212.     concat@&(isprime -> [id] ; %<>)@&(+@[id %1]@*@[id %2])@iota
  1213. }
  1214. Funky!Stuff!
  1215. cat - << \Funky!Stuff! > symtab.c
  1216. /*
  1217.  * Yet another symbol tabler
  1218.  *
  1219.  *    Copyright (c) 1986 by Andy Valencia
  1220.  */
  1221. #include "symtab.h"
  1222.  
  1223. extern char *strcpy();
  1224.  
  1225.     /*
  1226.      * Our hash table
  1227.      */
  1228. static struct symtab
  1229.     *stab[SYMTABSIZE];
  1230.  
  1231.     /*
  1232.      * Generate a hash value for a string
  1233.      */
  1234. static
  1235. hash(p)
  1236.     register char *p;
  1237. {
  1238.     register s = 0, c;
  1239.  
  1240.     while( c = *p++ ) s += c;
  1241.     return( s % SYMTABSIZE );
  1242. }
  1243.  
  1244.     /*
  1245.      * Allocate a new entry, fill in the salient fields
  1246.      */
  1247. static struct symtab *
  1248. new_entry(n)
  1249.     char *n;
  1250. {
  1251.     struct symtab *p = (struct symtab *)malloc(sizeof(struct symtab));
  1252.  
  1253.     p->sym_type = SYM_NEW;
  1254.     p->sym_next = 0;
  1255.     p->sym_val.YYint = 0;
  1256.     p->sym_pname = malloc((unsigned)(strlen(n)+1));
  1257.     (void)strcpy(p->sym_pname,n);
  1258.     return(p);
  1259. }
  1260.  
  1261.     /*
  1262.      * Given a string, go find the entry.  Allocate an entry if there
  1263.      *    was none.
  1264.      */
  1265. struct symtab *
  1266. lookup(name)
  1267.     char *name;
  1268. {
  1269.     register h;
  1270.     struct symtab
  1271.     *p = stab[h = hash(name)],
  1272.     *old;
  1273.  
  1274.     /*
  1275.      * No hash hits, must be a new entry
  1276.      */
  1277.     if( p == 0 ){
  1278.     return( stab[h] = new_entry(name) );
  1279.     }
  1280.  
  1281.     /*
  1282.      * Had hits, work way down list
  1283.      */
  1284.     while( p ){
  1285.     if( strcmp(p->sym_pname,name) == 0 ) return(p);
  1286.     old = p;
  1287.     p = p->sym_next;
  1288.     }
  1289.  
  1290.     /*
  1291.      * No hits, add to end of chain
  1292.      */
  1293.     return( old->sym_next = new_entry(name) );
  1294. }
  1295.  
  1296.     /*
  1297.      * Local function to do built-in stuffing
  1298.      */
  1299. static void
  1300. stuff(sym, val)
  1301.     char *sym;
  1302.     int val;
  1303. {
  1304.     struct symtab *p = lookup(sym);
  1305.  
  1306.     if( p->sym_type != SYM_NEW ) fatal_err("Dup init in stuff()");
  1307.     p->sym_type = SYM_BUILTIN;
  1308.     p->sym_val.YYint = val;
  1309. }
  1310.  
  1311.     /*
  1312.      * Fill in symbol table with built-ins
  1313.      */
  1314. void
  1315. symtab_init(){
  1316.     stuff( "and", AND );
  1317.     stuff( "or", OR );
  1318.     stuff( "xor", XOR );
  1319.     stuff( "sin", SIN );
  1320.     stuff( "cos", COS );
  1321.     stuff( "tan", TAN );
  1322.     stuff( "asin", ASIN );
  1323.     stuff( "acos", ACOS );
  1324.     stuff( "atan", ATAN );
  1325.     stuff( "log", LOG );
  1326.     stuff( "exp", EXP );
  1327.     stuff( "mod", MOD );
  1328.     stuff( "concat", CONCAT );
  1329.     stuff( "last", LAST );
  1330.     stuff( "first", FIRST );
  1331.     stuff( "tl", TL );
  1332.     stuff( "hd", HD );
  1333.     stuff( "id", ID );
  1334.     stuff( "atom", ATOM );
  1335.     stuff( "eq", EQ );
  1336.     stuff( "not", NOT );
  1337.     stuff( "null", NIL );
  1338.     stuff( "reverse", REVERSE );
  1339.     stuff( "distl", DISTL );
  1340.     stuff( "distr", DISTR );
  1341.     stuff( "length", LENGTH );
  1342.     stuff( "trans", TRANS );
  1343.     stuff( "apndl", APNDL );
  1344.     stuff( "apndr", APNDR );
  1345.     stuff( "tlr", TLR );
  1346.     stuff( "front", FRONT );
  1347.     stuff( "rotl", ROTL );
  1348.     stuff( "rotr", ROTR );
  1349.     stuff( "iota", IOTA );
  1350.     stuff( "pair", PAIR );
  1351.     stuff( "split", SPLIT );
  1352.     stuff( "out", OUT );
  1353.     stuff( "while", WHILE );
  1354.     stuff( "pick", PICK );
  1355.     stuff( "div", DIV );
  1356.     stuff( "T", T );
  1357.     stuff( "F", F );
  1358. }
  1359. Funky!Stuff!
  1360. cat - << \Funky!Stuff! > symtab.h
  1361. /*
  1362.  * Yet another symbol tabler
  1363.  *
  1364.  *    Copyright (c) 1986 by Andy Valencia
  1365.  */
  1366. #include "fp.h"
  1367. #include "y.tab.h"
  1368.  
  1369. #define SYMTABSIZE 101
  1370.  
  1371.     /*
  1372.      * sym_type values
  1373.      */
  1374. #define SYM_BUILTIN 1        /* A built-in */
  1375. #define SYM_DEF 2        /* User-defined */
  1376. #define SYM_NEW 3        /* Never seen before! */
  1377. Funky!Stuff!
  1378. cat - << \Funky!Stuff! > test.fp
  1379. #
  1380. # Test cases for FP
  1381. #
  1382. )load blah
  1383. )blah
  1384. ~
  1385. +:<1 2>
  1386. +:<1.0 2.0>
  1387. +:<1>
  1388. +:?
  1389. +:<>
  1390. +:<1 2 3>
  1391. -:<1 2>
  1392. -:<1.0 2.0>
  1393. -:<1>
  1394. -:?
  1395. *:<1 2>
  1396. *:<1.0 2.0>
  1397. *:<1>
  1398. *:?
  1399. mod:<1 2>
  1400. mod:<1.0 2.0>
  1401. mod:<1>
  1402. mod:?
  1403. mod:<1 0>
  1404. mod:< <1> <2> >
  1405. /:<1 2>
  1406. /:<1.0 2.0>
  1407. /:<1>
  1408. /:?
  1409. /:<1 0>
  1410. /:< <1> <2> >
  1411. <:<1 2>
  1412. <:<1.0 2.0>
  1413. <:<1>
  1414. <:<1 T>
  1415. <:?
  1416. >:<1 2>
  1417. >:<1.0 2.0>
  1418. >:<1>
  1419. >:?
  1420. >=:<1 2>
  1421. >=:<1.0 2.0>
  1422. >=:<1>
  1423. >=:?
  1424. <=:<1 2>
  1425. <=:<1.0 2.0>
  1426. <=:<1>
  1427. <=:?
  1428. eq:<1 2>
  1429. eq:<1 1>
  1430. eq:<1 T>
  1431. eq:<1.0 2.0>
  1432. eq:< <1 2> <1 2> >
  1433. eq:< <1 2> <1 3> >
  1434. eq:?
  1435. =:<1 2>
  1436. =:<1 1>
  1437. =:<1 T>
  1438. =:<1.0 2.0>
  1439. =:< <1 2> <1 2> >
  1440. =:< <1 2> <1 3> >
  1441. =:?
  1442. ~=:<1 2>
  1443. ~=:<1 1>
  1444. ~=:< <1 2> <1 2> >
  1445. ~=:< <1 2> <1 3> >
  1446. ~=:?
  1447. hd:<1 2 3>
  1448. hd:1
  1449. hd:?
  1450. tl:<>
  1451. tl:<1>
  1452. tl:<1 2>
  1453. tl:<1 2 3>
  1454. tl:1
  1455. tl:?
  1456. iota:9
  1457. iota:<9>
  1458. &id@iota:9
  1459. &%1:?
  1460. &+:<>
  1461. |+@iota:9
  1462. |+:<1>
  1463. |+:<>
  1464. |-:<>
  1465. |=:<>
  1466. |+:?
  1467. |and:<>
  1468. |or:<>
  1469. |xor:<>
  1470. |/:<>
  1471. |/:<1 0 0>
  1472. |*:<>
  1473. |id:<>
  1474. |%7:?
  1475. |%7:<>
  1476. !+@iota:9
  1477. !+:<1>
  1478. !+:<>
  1479. !-:<>
  1480. !+:?
  1481. !=:<>
  1482. !and:<>
  1483. !or:<>
  1484. !xor:<>
  1485. !/:<>
  1486. !/:<1 2 0>
  1487. !*:<>
  1488. !id:<>
  1489. !%7:<>
  1490. !%7:?
  1491. &(+@[%1, id])@iota:9
  1492. [id, id, +, id]:9
  1493. (1 -> 2 ; 3):<T 1 2>
  1494. (1 -> 2 ; 3):<F 1 2>
  1495. (1 -> 2 ; 3):<? 1 2>
  1496. (1 -> 2 ; 3):<1 1 2>
  1497. %?:9
  1498. 9:<1 2 3>
  1499. 3:<1 2>
  1500. &+:< <1 2> <3> <4 5> >
  1501. %7:?
  1502. hd:<>
  1503. tl:<>
  1504. iota:-8
  1505. %+5:<4>
  1506. (while 1 tl ):<T F>
  1507. (while 1 tl):<1 F>
  1508. (while 1 /@tl ):<T <1 0>>
  1509. length:?
  1510. length:1
  1511. length:<>
  1512. length:<1>
  1513. length:<1 2>
  1514. reverse:?
  1515. reverse:<>
  1516. reverse:<1>
  1517. reverse:<1 2>
  1518. first:?
  1519. first:<>
  1520. first:<1>
  1521. first:<1 2>
  1522. last:?
  1523. last:<>
  1524. last:<1>
  1525. last:<1 2>
  1526. atom:?
  1527. atom:1
  1528. atom:T
  1529. atom:<>
  1530. atom:<1>
  1531. pick:?
  1532. pick:<2 <7 8 9>>
  1533. pick:<T <7 8 9>>
  1534. pick:<2 T>
  1535. pick:<99 <1 2 3>>
  1536. pick:<4 <1 2 3>>
  1537. pick:<0 <>>
  1538. pick:<>
  1539. pick:<2>
  1540. not:1
  1541. not:T
  1542. null:<>
  1543. null:<1>
  1544. null:<1 2>
  1545. null:?
  1546. reverse:?
  1547. reverse:<>
  1548. reverse:<1>
  1549. reverse:<1 2>
  1550. reverse:<1 2 3>
  1551. distl:<>
  1552. distl:?
  1553. distl:<1 <2 3 4>>
  1554. distl:<1 2>
  1555. distr:<>
  1556. distr:?
  1557. distr:<<2 3 4> 1>
  1558. distr:<1 2>
  1559. trans:<>
  1560. trans:?
  1561. trans:< <1 2 3> <4 5 6> >
  1562. trans:< <1 2> <3 4 5> >
  1563. trans:< <1 2> T >
  1564. trans:< <> <> >
  1565. apndl:< T <1 2 3>>
  1566. apndl:?
  1567. apndl:<<1 2 3> 4>
  1568. apndl:<<1 2> <3 4>>
  1569. apndl:<1 <>>
  1570. apndr:< T <1 2 3>>
  1571. apndr:?
  1572. apndr:<<1 2 3> 4>
  1573. apndr:<<1 2> <3 4>>
  1574. apndr:<1 <>>
  1575. tlr:?
  1576. tlr:<>
  1577. tlr:<1>
  1578. tlr:<1 2 3>
  1579. front:?
  1580. front:<>
  1581. front:<1>
  1582. front:<1 2>
  1583. rotl:?
  1584. rotl:<>
  1585. rotl:<1>
  1586. rotl:<1 2 3>
  1587. rotr:?
  1588. rotr:<>
  1589. rotr:<1>
  1590. rotr:<1 2 3>
  1591. pair:<>
  1592. pair:?
  1593. pair:<1>
  1594. pair:<1 2>
  1595. pair:<1 2 3>
  1596. split:<>
  1597. split:?
  1598. split:<1>
  1599. split:<1 2>
  1600. split:<1 2 3>
  1601. concat:?
  1602. concat:<>
  1603. concat:<<>>
  1604. concat:< <> <1> <2> <> >
  1605. concat:< <> <1> T <> >
  1606. id:?
  1607. id:1
  1608. out:?
  1609. out:1
  1610. sin:?
  1611. sin:1
  1612. cos:?
  1613. cos:1
  1614. tan:?
  1615. tan:1
  1616. log:?
  1617. log:1
  1618. exp:?
  1619. exp:1
  1620. asin:?
  1621. asin:1
  1622. acos:?
  1623. acos:1
  1624. atan:?
  1625. atan:1
  1626. or:?
  1627. or:<1 2>
  1628. or:<T 2>
  1629. or:<T T>
  1630. or:<1 T>
  1631. or:< 1 2 3 >
  1632. and:?
  1633. and:<1 2>
  1634. and:<T 2>
  1635. and:<T T>
  1636. and:<1 T>
  1637. and:< 1 2 3 >
  1638. xor:?
  1639. xor:<1 2>
  1640. xor:<T 2>
  1641. xor:<T T>
  1642. xor:<1 T>
  1643. xor:< 1 2 3 >
  1644. {a 1}
  1645. {a 2}
  1646. a:<4 5 6>
  1647. {b a@a}
  1648. Funky!Stuff!
  1649.