diff --git a/thun/crap-n-stuff.txt b/thun/crap-n-stuff.txt new file mode 100644 index 0000000..7507386 --- /dev/null +++ b/thun/crap-n-stuff.txt @@ -0,0 +1,93 @@ + + +combo(branch, [T, F, Expr|S], S, Ei, Eo) :- + \+ Expr = true, \+ Expr = false, + catch( % Try Expr and do one or the other, + (Expr -> append(T, Ei, Eo) ; append(F, Ei, Eo)), + _, % If Expr don't grok, try both branches. + (append(T, Ei, Eo) ; append(F, Ei, Eo)) + ). + +combo(loop, [B, Expr|S], S, Ei, Eo) :- + \+ Expr = true, \+ Expr = false, + catch( % Try Expr and do one or the other, + (Expr -> append(B, [B, loop|Ei], Eo) ; Ei=Eo), + _, % If Expr don't grok, try both branches. + (Ei=Eo ; append(B, [B, loop|Ei], Eo)) + ). + +/* + +To handle comparision operators the possibility of exceptions due to +insufficiently instantiated arguments must be handled. First try to make +the comparison and set the result to a Boolean atom. If an exception +happens just leave the comparison expression as the result and some other +function or combinator will deal with it. Example: + + func(>, [A, B|S], [C|S]) :- catch( + (B > A -> C=true ; C=false), + _, + C=(B>A) % in case of error. + ). + +To save on conceptual overhead I've defined a term_expansion/2 that sets +up the func/3 for each op. +*/ + +term_expansion(comparison_operator(X), (func(X, [A, B|S], [C|S]) :- + F =.. [X, B, A], catch((F -> C=true ; C=false), _, C=F))). + +% I don't use Prolog-compatible op symbols in all cases. +term_expansion(comparison_operator(X, Y), (func(X, [A, B|S], [C|S]) :- + F =.. [Y, B, A], catch((F -> C=true ; C=false), _, C=F))). + +% Likewise for math operators, try to evaluate, otherwise use the +% symbolic form. + +term_expansion(math_operator(X), (func(X, [A, B|S], [C|S]) :- + F =.. [X, B, A], catch(C is F, _, C=F))). + +term_expansion(math_operator(X, Y), (func(X, [A, B|S], [C|S]) :- + F =.. [Y, B, A], catch(C is F, _, C=F))). + + + +% Symbolic math expressions are literals. +literal(_+_). +literal(_-_). +literal(_*_). +literal(_/_). +literal(_ mod _). + +% Symbolic comparisons are literals. +literal(_>_). +literal(_<_). +literal(_>=_). +literal(_=<_). +literal(_=:=_). +literal(_=\=_). + + + +% Symbolic math. Compute the answer, or derivative, or whatever, later. +math_operator(+). +math_operator(-). +math_operator(*). +math_operator(/). +math_operator(mod). + +% Attempt to calculate the value of a symbolic math expression. +func(calc, [A|S], [B|S]) :- B is A. + +func(sqrt, [A|S], [sqrt(A)|S]). + + +comparison_operator(>). +comparison_operator(<). +comparison_operator(>=). +comparison_operator(<=, =<). +comparison_operator(=, =:=). +comparison_operator(<>, =\=). + + + diff --git a/thun/defs.pl b/thun/defs.pl new file mode 100644 index 0000000..5a2853c --- /dev/null +++ b/thun/defs.pl @@ -0,0 +1,76 @@ +% Apparently there's no good way to have multi-line string literals in +% Prolog code. I could do something like this: + +def(`-- 1 -`). +def(`? dup bool`). +def(`++ 1 +`). +def(`anamorphism [pop []] swap [dip swons] genrec`). +def(`app1 grba infrst`). +def(`app2 [grba swap grba swap] dip [infrst] cons ii`). +def(`app3 3 appN`). +def(`appN [grabN] cons dip map disenstacken`). +def(`at drop first`). +def(`average [sum 1.0 *] [size] cleave /`). +def(`b [i] dip i`). +def(`binary unary popd`). +def(`ccons cons cons`). +def(`cleave fork popdd`). +def(`clop cleave popdd`). +def(`codireco cons dip rest cons`). +def(`dinfrirst dip infrst`). +def(`disenstacken ? [uncons ?] loop pop`). +def(`down_to_zero [0 >] [dup --] while`). +def(`drop [rest] times`). +def(`dupd [dup] dip`). +def(`dupdd [dup] dipd`). +def(`dupdipd dup dipd`). +def(`enstacken stack [clear] dip`). +def(`flatten [] swap [concat] step`). +def(`fork [i] app2`). +def(`fourth rest third`). +def(`gcd true [tuck mod dup 0 >] loop pop`). +def(`grabN [] swap [cons] times`). +def(`grba [stack popd] dip`). +def(`hypot [sqr] ii + sqrt`). +def(`ifte [nullary] dipd swap branch`). +def(`ii [dip] dupdip i`). +def(`infra swons swaack [i] dip swaack`). +def(`infrst infra first`). +def(`make_generator [codireco] ccons`). +def(`neg 0 swap -`). +def(`not [true] [false] branch`). +def(`nullary [stack] dinfrirst`). +def(`of swap at`). +def(`pam [i] map`). +def(`pm [+] [-] clop`). +def(`popd [pop] dip`). +def(`popdd [pop] dipd`). +def(`popop pop pop`). +def(`popopd [popop] dip`). +def(`popopdd [popop] dipd`). +def(`primrec [i] genrec`). +def(`product 1 swap [*] step`). +def(`quoted [unit] dip`). +def(`range [0 <=] [1 - dup] anamorphism`). +def(`range_to_zero unit [down_to_zero] infra`). +def(`reverse [] swap shunt`). +def(`rrest rest rest`). +def(`run [] swap infra`). +def(`second rest first`). +def(`shift uncons [swons] dip`). +def(`shunt [swons] step`). +def(`size 0 swap [pop ++] step`). +def(`split_at [drop] [take] clop`). +def(`sqr dup *`). +def(`step_zero 0 roll> step`). +def(`sum 0 swap [+] step`). +def(`swons swap cons`). +def(`take [] rolldown [shift] times pop`). +def(`ternary binary popd`). +def(`third rest second`). +def(`unary nullary popd`). +def(`unit [] cons`). +def(`unquoted [i] dip`). +def(`unswons uncons swap`). +def(`while swap [nullary] cons dup dipd concat loop`). +def(`x dup i`). \ No newline at end of file