allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) (10/01/89)
Posting-number: Volume 8, Issue 88
Submitted-by: eugene@eos.arc.nasa.gov
Archive-name: qhwc
Bill Burke, Lick Observatory, Astronomy/Physics Dept, UC Santa Cruz
has asked me to post this. Qhwc (silent Q, pronounced "hawk," for K/P's hoc
calculator, yet another pun, and dedicated to physicist Stephen Hawking.)
The code can be in the public domain, but he asks that users
of quaterions send him a copy of papers on sample research areas
they are using quaterions requiring this calcuator). You can either mail
directly to him (no email, but reachable at UCSC) or me.
He said to say, "Yes, some physicists do program using lex and yacc.
And like Unix. Way to go."
Another gross generalization from
--eugene miya, NASA Ames Research Center, eugene@aurora.arc.nasa.gov
resident cynic at the Rock of Ages Home for Retired Hackers:
"You trust the `reply' command with all those different mailers out there?"
"If my mail does not reach you, please accept my apology."
{ncar,decwrl,hplabs,uunet}!ames!eugene
Live free or die.
--------snip here and run thru sh-----------
echo x - Makefile
sed 's/^X//' >Makefile <<'*-*-END-of-Makefile-*-*'
XFILES= Makefile qhwc.c qhwc.l qhwc.y
XOBJECTS= y.tab.o lex.yy.o qhwc.o
XLIBES= -lm -ll
XCFLAGS= -O
X
Xqhwk: $(OBJECTS)
X cc $(CFLAGS) $(OBJECTS) $(LIBES) -o qhwk
X
Xy.tab.c: qhwc.y
X yacc -d qhwc.y
X
Xlex.yy.c: qhwc.l
X lex qhwc.l
X
Xclean:
X rm *.o y.tab.[hc] lex.yy.c
*-*-END-of-Makefile-*-*
echo x - qhwc.c
sed 's/^X//' >qhwc.c <<'*-*-END-of-qhwc.c-*-*'
X#include <stdio.h>
X#include <math.h>
X
Xtypedef struct
X{
X double real, imag, jmag, kmag;
X} QRT;
X
X#include "y.tab.h"
X
Xdouble obj[8][4];
Xint j;
X
Xint main()
X{
X double u;
X
X printf("QHWC: William's Quaternionic Hand Calculator \n\n");
X printf("Last expression is H0, then H1, up to H7 \n");
X printf("Use h as a shorthand for H0, the previous one\n");
X printf("Operators: + - * % (u minus) (h*=CCG) exp |h| \n");
X printf(" pi if(,,) Re Pu (Re(h)+Pu(h)=h) \n");
X printf("Enter expression to calculate (^D to quit): \n\n");
X for ( j=0; j<8; ++j) {
X obj[j][0] = 0;
X obj[j][1] = 0;
X obj[j][2] = 0;
X obj[j][3] = 0;
X }
X
X return (yyparse());
X}
*-*-END-of-qhwc.c-*-*
echo x - qhwc.l
sed 's/^X//' >qhwc.l <<'*-*-END-of-qhwc.l-*-*'
X%{
Xdouble pi=3.141592654;
Xtypedef struct qrt
X{
X double real, imag, jmag, kmag;
X} QRT;
X#include "y.tab.h"
X
Xdouble rbuff;
X
X%}
X
X%%
X
X[0-9]+(\.[0-9]+)? {
X sscanf(yytext,"%lf",&rbuff);
X yylval.hval.real = rbuff;
X yylval.hval.imag = 0;
X yylval.hval.jmag = 0;
X yylval.hval.kmag = 0;
X return H;
X }
X[0-9]+(\.[0-9]+)?i {
X yytext[yyleng-1] = '\0';
X sscanf(yytext,"%lf",&rbuff);
X yylval.hval.real = 0;
X yylval.hval.imag = rbuff;
X yylval.hval.jmag = 0;
X yylval.hval.kmag = 0;
X return H;
X }
X[0-9]+(\.[0-9]+)?j {
X yytext[yyleng-1] = '\0';
X sscanf(yytext,"%lf",&rbuff);
X yylval.hval.real = 0;
X yylval.hval.imag = 0;
X yylval.hval.jmag = rbuff;
X yylval.hval.kmag = 0;
X return H;
X }
X[0-9]+(\.[0-9]+)?k {
X yytext[yyleng-1] = '\0';
X sscanf(yytext,"%lf",&rbuff);
X yylval.hval.real = 0;
X yylval.hval.imag = 0;
X yylval.hval.jmag = 0;
X yylval.hval.kmag = rbuff;
X return H;
X }
X[hH][0-7] { /* recalling previous from stack */
X yylval.intval = (int) (yytext[1]-'0');
X return OBJECT;
X }
Xh {
X yylval.intval = 0;
X return OBJECT;
X }
XRe {
X return RE;
X }
X[sS][qQ][rR][tT] {
X return SQRT;
X }
X[sS][qQ] {
X return SQ;
X }
X[eE][xX][pP] {
X return EXP;
X }
X[iI][fF] {
X return IF;
X }
XPu {
X return PU;
X }
X[pP][iI] {
X yylval.hval.real = pi;
X yylval.hval.imag = 0;
X yylval.hval.jmag = 0;
X yylval.hval.kmag = 0;
X return H;
X }
Xi {
X yylval.hval.real = 0;
X yylval.hval.imag = 1.0;
X yylval.hval.jmag = 0;
X yylval.hval.kmag = 0;
X return H;
X }
Xj {
X yylval.hval.real = 0;
X yylval.hval.imag = 0;
X yylval.hval.jmag = 1.0;
X yylval.hval.kmag = 0;
X return H;
X }
Xk {
X yylval.hval.real = 0;
X yylval.hval.imag = 0;
X yylval.hval.jmag = 0;
X yylval.hval.kmag = 1.0;
X return H;
X }
X[-()|+/*,\n] return *yytext;
X[ \t]+ ;
X. {yyerror("Unrecognized input: %s\n",yytext);}
X
X%%
X
*-*-END-of-qhwc.l-*-*
echo x - qhwc.y
sed 's/^X//' >qhwc.y <<'*-*-END-of-qhwc.y-*-*'
X%{
X
X#include <math.h>
X
Xtypedef struct qrt
X{
X double real, imag, jmag, kmag;
X} QRT;
X
Xdouble sqrt(), sin(), cos(), exp();
Xdouble x,r,rsqd,theta;
XQRT hh, hhh, hcc;
Xextern double obj[8][4];
Xextern double pi;
Xint i;
X
X%}
X
X%union {
X int intval;
X double realval;
X QRT hval;
X }
X
X%token <hval> H
X%token <intval> OBJECT
X%left '+' '-'
X%left '*' '/'
X%right SQ SQRT EXP IF
X%right RE PU
X%left UMINUS CCG
X
X%type <hval> expression program
X
X%%
X
Xprogram:
X program expression '\n' = { printf("%lf + %lfi + %lfj + %lfk \n",
X $2.real, $2.imag, $2.jmag, $2.kmag);
X for ( i=7; i>0; --i) {
X obj[i][0] = obj[i-1][0];
X obj[i][1] = obj[i-1][1];
X obj[i][2] = obj[i-1][2];
X obj[i][3] = obj[i-1][3];
X }
X obj[0][0] = $2.real;
X obj[0][1] = $2.imag;
X obj[0][2] = $2.jmag;
X obj[0][3] = $2.kmag;
X }
X| program error '\n' = { yyerrok; }
X| /* NULL */ = {}
X;
X
Xexpression:
X H = { $$.real = $1.real;
X $$.imag = $1.imag;
X $$.jmag = $1.jmag;
X $$.kmag = $1.kmag;
X }
X| OBJECT = { $$.real = obj[$1][0];
X $$.imag = obj[$1][1];
X $$.jmag = obj[$1][2];
X $$.kmag = obj[$1][3];
X }
X| expression '+' expression = { $$.real = $1.real + $3.real;
X $$.imag = $1.imag + $3.imag;
X $$.jmag = $1.jmag + $3.jmag;
X $$.kmag = $1.kmag + $3.kmag;
X }
X| expression '-' expression = { $$.real = $1.real - $3.real;
X $$.imag = $1.imag - $3.imag;
X $$.jmag = $1.jmag - $3.jmag;
X $$.kmag = $1.kmag - $3.kmag;
X }
X| expression '*' expression = {
X Multiply(&$1,&$3,&$$);
X }
X| expression '/' expression = {
X Conjugate(&$3,&hcc);
X Multiply(&$3,&hcc,&hh);
X hh.real = 1/(hh.real);
X Multiply(&$1,&hcc,&hhh);
X Multiply(&hh,&hhh,&$$);
X }
X| RE expression = { $$.real = $2.real;
X $$.imag = 0;
X $$.jmag = 0;
X $$.kmag = 0;
X }
X| PU expression = { $$.real = 0;
X $$.imag = $2.imag;
X $$.jmag = $2.jmag;
X $$.kmag = $2.kmag;
X }
X| EXP '(' expression ')' = {
X r = sqrt($3.imag*$3.imag+$3.jmag*$3.jmag+$3.kmag*$3.kmag);
X if ( r > 0.0) {
X $$.real = exp($3.real)*cos(r);
X $$.imag = exp($3.real)*sin(r)*$3.imag/r;
X $$.jmag = exp($3.real)*sin(r)*$3.jmag/r;
X $$.kmag = exp($3.real)*sin(r)*$3.kmag/r;
X } else {
X $$.real = exp($3.real);
X $$.imag = 0.0;
X $$.jmag = 0.0;
X $$.kmag = 0.0;
X }
X }
X| IF '(' expression ',' expression',' expression ')' = {
X if ( $3.real > 0) {
X $$.real = $5.real;
X $$.imag = $5.imag;
X $$.jmag = $5.jmag;
X $$.kmag = $5.kmag;
X }
X else {
X $$.real = $7.real;
X $$.imag = $7.imag;
X $$.jmag = $7.jmag;
X $$.kmag = $7.kmag;
X }
X }
X| '-' expression %prec UMINUS = { $$.real = -$2.real;
X $$.imag = -$2.imag;
X $$.jmag = -$2.jmag;
X $$.kmag = -$2.kmag;
X }
X| expression '*' %prec CCG = { $$.real = $1.real;
X $$.imag = -$1.imag;
X $$.jmag = -$1.jmag;
X $$.kmag = -$1.kmag;
X }
X| '(' expression ')' = { $$.real = $2.real;
X $$.imag = $2.imag;
X $$.jmag = $2.jmag;
X $$.kmag = $2.kmag;
X }
X| '|' expression '|' = {
X Conjugate(&$2,&hcc);
X Multiply(&$2,&hcc,&hh);
X $$.real = sqrt(hh.real);
X $$.imag = 0;
X $$.jmag = 0;
X $$.kmag = 0;
X }
X;
X
X%%
X
X
Xvoid Multiply (hh1, hh2, hh3)
XQRT *hh1, *hh2, *hh3;
X{
X hh3->real = hh1->real * hh2->real - hh1->imag * hh2->imag
X -hh1->jmag * hh2->jmag - hh1->kmag * hh2->kmag;
X hh3->imag = hh1->real * hh2->imag + hh1->imag * hh2->real
X +hh1->jmag * hh2->kmag - hh1->kmag * hh2->jmag;
X hh3->jmag = hh1->real * hh2->jmag + hh1->jmag * hh2->real
X +hh1->kmag * hh2->imag - hh1->imag * hh2->kmag;
X hh3->kmag = hh1->real * hh2->kmag + hh1->kmag * hh2->real
X +hh1->imag * hh2->jmag - hh1->jmag * hh2->imag;
X}
X
Xvoid Conjugate (hh1, hh2)
XQRT *hh1, *hh2;
X{
X hh2->real = hh1->real;
X hh2->imag = -hh1->imag;
X hh2->jmag = -hh1->jmag;
X hh2->kmag = -hh1->kmag;
X}
X
Xyyerror(s)
Xchar *s;
X{
X printf("%s\n",s);
X}
*-*-END-of-qhwc.y-*-*
exit