Move all definitions to defs.txt.

This commit is contained in:
Simon Forman 2019-07-15 16:11:49 -07:00
parent ee395e91f1
commit 9ebc64541a
2 changed files with 47 additions and 46 deletions

View File

@ -1,31 +1,61 @@
++ == 1 +
anamorphism == [pop []] swap [dip swons] genrec
app1 == grba infrst
app2 == [grba swap grba swap] dip [infrst] cons ii
at == drop first
average == [sum 1.0 *] [size] cleave /
b == [i] dip i
binary == unary popd
ccons == cons cons
cleave == fork [popd] dip
codireco == cons dip rest cons
dinfrirst == dip infra first
disenstacken == ? [uncons ?] loop pop
down_to_zero == [0 >] [dup --] while
drop == [rest] times
dupd == [dup] dip
dupdd == [dup] dipd
dupdipd == dup dipd
enstacken == stack [clear] dip
flatten == [] swap [concat] step
fork == [i] app2
fourth == rest third
gcd == 1 [tuck modulus dup 0 >] loop pop
grba == [stack popd] dip
ifte == [nullary] dipd swap branch
ii == [dip] dupdip i
infra == swons swaack [i] dip swaack
infrst == infra first
make_generator == [codireco] ccons
neg == 0 swap -
nullary == stack popd [i] infrst
of == swap at
pam == [i] map
pm == [+] [-] cleave popdd
popd == [pop] dip
popdd == [pop] dipd
popop == pop pop
popopd == [popop] dip
popopdd == [popop] dipd
primrec == [i] genrec
product == 1 swap [*] step
product == 1 swap [*] step
quoted == [unit] dip
range == [0 <=] [1 - dup] anamorphism
range_to_zero == unit [down_to_zero] infra
rrest == rest rest
run == [] swap infra
second == rest first
size == 0 swap [pop ++] step
sqr == dup *
step_zero == 0 roll> step
sum == 0 swap [+] step
swons == swap cons
ternary == binary popd
third == rest second
unary == nullary popd
unit == [] cons
unquoted == [i] dip
unswons == uncons swap
while == swap [nullary] cons dup dipd concat loop
x == dup i

View File

@ -51,10 +51,6 @@ chars([Ch]) --> char(Ch).
char(Ch) --> [Ch], {Ch \== 91, Ch \== 93, code_type(Ch, graph)}.
joy_def(Def Body) --> symbol(Def), blanks, "==", joy_parse(Body).
joy_defs([Def|Defs]) --> blanks, joy_def(Def), blanks, joy_defs(Defs).
joy_defs([]) --> [].
/*
Interpreter
@ -145,36 +141,23 @@ r_truth(1, true).
/*
Definitions
*/
app1 [grba, infrst].
app2 [[grba, swap, grba, swap], dip, [infrst], cons, ii].
at [drop, first].
b [[i], dip, i].
ccons [cons, cons].
drop [[rest], times].
dupd [[dup], dip].
dupdd [[dup], dipd].
fourth [rest, third].
grba [[stack, popd], dip].
ifte [[nullary], dipd, swap, branch].
ii [[dip], dupdip, i].
infra [swons, swaack, [i], dip, swaack].
infrst [infra, first].
neg [0, swap, -].
nullary [stack, popd, [i], infrst].
pm [[+], [-], cleave, popdd].
popd [[pop], dip].
popdd [[pop], dipd].
popop [pop, pop].
popopd [[popop], dip].
popopdd [[popop], dipd].
product [1, swap, [*], step].
rrest [rest, rest].
second [rest, first].
sum [0, swap, [+], step].
swons [swap, cons].
third [rest, second].
unit [[], cons].
unswons [uncons, swap].
joy_def(Def Body) --> symbol(Def), blanks, "==", joy_parse(Body).
joy_defs([Def|Defs]) --> blanks, joy_def(Def), blanks, joy_defs(Defs).
joy_defs([]) --> [].
read_defs(DefsFile, Defs) :-
read_file_to_codes(DefsFile, Codes, []),
phrase(joy_defs(Defs), Codes).
assert_defs(DefsFile) :-
read_defs(DefsFile, Defs),
forall(member(Def, Defs), assert_def(Def)).
assert_def(DefBody) :- retractall(Def_), assertz(DefBody).
:- assert_defs("defs.txt").
/*
@ -228,15 +211,3 @@ contracto, [Def] --> {Def ≡ Body}, Body.
% phrase(expando, ExprIn, ExprOut).
read_defs(DefsFile, Defs) :-
read_file_to_codes(DefsFile, Codes, []),
phrase(joy_defs(Defs), Codes).
assert_defs(DefsFile) :-
read_defs(DefsFile, Defs),
forall(member(Def, Defs), assert_def(Def)).
assert_def(DefBody) :- retractall(Def_), assertz(DefBody).
:- assert_defs("defs.txt").