A small standalone Lisp used as a scripting language in the Z2 game engine
Revision | cfdb0eb969d20b5506a1e8038c405ef3e74fbd32 (tree) |
---|---|
Zeit | 2019-11-10 05:13:08 |
Autor | AlaskanEmily <emily@alas...> |
Commiter | AlaskanEmily |
Fix reduce when not all variables are bound
@@ -15,6 +15,7 @@ | ||
15 | 15 | :- use_module assoc_list. |
16 | 16 | :- use_module rbtree. |
17 | 17 | :- use_module maybe. |
18 | +:- use_module univ. | |
18 | 19 | |
19 | 20 | %-----------------------------------------------------------------------------% |
20 | 21 | % TODO! |
@@ -41,6 +42,17 @@ | ||
41 | 42 | |
42 | 43 | %-----------------------------------------------------------------------------% |
43 | 44 | |
45 | +:- type call_error ---> | |
46 | + error(string) ; | |
47 | + no_such_bind ; | |
48 | + arity_error. | |
49 | + | |
50 | +%-----------------------------------------------------------------------------% | |
51 | + | |
52 | +:- type call_result == maybe.maybe_error(element, call_error). | |
53 | + | |
54 | +%-----------------------------------------------------------------------------% | |
55 | + | |
44 | 56 | :- inst maybe_unique_error ---> |
45 | 57 | maybe.ok(ground) ; |
46 | 58 | maybe.error(unique). |
@@ -78,7 +90,7 @@ | ||
78 | 90 | globals::variables, |
79 | 91 | binds::rbtree.rbtree(bind_spec, bind), |
80 | 92 | stack_frames::list.list(frame), |
81 | - pending_io::list.list(string)). | |
93 | + pending_io::list.list(univ.univ)). | |
82 | 94 | |
83 | 95 | %-----------------------------------------------------------------------------% |
84 | 96 |
@@ -111,7 +123,8 @@ | ||
111 | 123 | :- pred pop_stack_frame_check(int::in, runtime::in, runtime::out) is det. |
112 | 124 | |
113 | 125 | %-----------------------------------------------------------------------------% |
114 | - | |
126 | +% Defines a variable with a specific name. | |
127 | +% This will replace any existing variable of the same name. | |
115 | 128 | :- pred def_var(string::in, element::in, runtime::in, runtime::out) is det. |
116 | 129 | |
117 | 130 | %-----------------------------------------------------------------------------% |
@@ -133,12 +146,21 @@ | ||
133 | 146 | :- mode find_bind(in, in, in, out) is semidet. |
134 | 147 | |
135 | 148 | %-----------------------------------------------------------------------------% |
136 | -% This is a workaround, as the Mercury compiler gets confused when disjuncting | |
137 | -% on functors which contain predicates as elements in the functor. | |
149 | +% Calls a specified bind with a given list of arguments. | |
150 | +% | |
151 | +% This is also used internally for all calls. Using it there is a workaround, | |
152 | +% as the Mercury compiler gets confused when disjuncting on functors which | |
153 | +% contain predicates as elements in the functor. | |
138 | 154 | :- pred call_bind(bind, list.list(element), result, runtime, runtime). |
139 | 155 | :- mode call_bind(in, in, res_uo, in, out) is det. |
140 | 156 | |
141 | 157 | %-----------------------------------------------------------------------------% |
158 | +% Calls a bind by spec. | |
159 | +% Reduces all arguments, checks arity (rather than throwing like call_bind/5). | |
160 | +:- pred call_bind_spec(bind_spec, list.list(element), call_result, runtime, runtime). | |
161 | +:- mode call_bind_spec(in, in, res_uo, in, out) is det. | |
162 | + | |
163 | +%-----------------------------------------------------------------------------% | |
142 | 164 | |
143 | 165 | :- type run_pred1 == (pred(element, result, runtime, runtime)). |
144 | 166 | :- inst run_pred1 == (pred(in, res_uo, in, out) is det). |
@@ -400,6 +422,10 @@ builtin_bind(args("-", 2), mercury_bind(turbolisp__runtime__builtin__builtin_min | ||
400 | 422 | builtin_bind(args("*", 2), mercury_bind(turbolisp__runtime__builtin__builtin_times_bind)). |
401 | 423 | builtin_bind(args("/", 2), mercury_bind(turbolisp__runtime__builtin__builtin_divide_bind)). |
402 | 424 | |
425 | +builtin_bind(args("&", 2), mercury_bind(turbolisp__runtime__builtin__builtin_and_bind)). | |
426 | +builtin_bind(args("|", 2), mercury_bind(turbolisp__runtime__builtin__builtin_or_bind)). | |
427 | +builtin_bind(args("^", 2), mercury_bind(turbolisp__runtime__builtin__builtin_xor_bind)). | |
428 | + | |
403 | 429 | builtin_bind(args("fn", 3), mercury_bind(turbolisp__runtime__builtin__builtin_fn_bind)). |
404 | 430 | |
405 | 431 | %-----------------------------------------------------------------------------% |
@@ -463,6 +489,44 @@ call_bind(lisp_bind(ArgNames, Body), Args, Result, !Runtime) :- | ||
463 | 489 | ). |
464 | 490 | |
465 | 491 | %-----------------------------------------------------------------------------% |
492 | + | |
493 | +call_bind_spec(Spec, Args, Result, !Runtime) :- | |
494 | + StartRuntime = !.Runtime, | |
495 | + ( if | |
496 | + require_complete_switch [Spec] ( | |
497 | + Spec = args(_, list.length(Args)) | |
498 | + ; | |
499 | + Spec = variadic(_) | |
500 | + ) | |
501 | + then | |
502 | + ( if | |
503 | + rbtree.search(StartRuntime ^ binds, Spec, Bind) | |
504 | + then | |
505 | + list.map_foldl2(execute, Args, ExecArgs, !Runtime, maybe.ok, ExecArgResult), | |
506 | + ( | |
507 | + ExecArgResult = maybe.ok, | |
508 | + call_bind(Bind, ExecArgs, CallResult, !Runtime), | |
509 | + ( | |
510 | + CallResult = maybe.ok(Return), | |
511 | + Result = maybe.ok(Return) | |
512 | + ; | |
513 | + CallResult = maybe.error(Error), | |
514 | + StartRuntime = !:Runtime, % Reset runtime. | |
515 | + Result = maybe.error(error(Error)) | |
516 | + ) | |
517 | + ; | |
518 | + ExecArgResult = maybe.error(Error), | |
519 | + StartRuntime = !:Runtime, % Reset runtime. | |
520 | + Result = maybe.error(error(Error)) | |
521 | + ) | |
522 | + else | |
523 | + Result = maybe.error(no_such_bind) | |
524 | + ) | |
525 | + else | |
526 | + Result = maybe.error(arity_error) | |
527 | + ). | |
528 | + | |
529 | +%-----------------------------------------------------------------------------% | |
466 | 530 | % Result of preprocessing. |
467 | 531 | % Comparison is a special case because of laziness. |
468 | 532 | :- type preprocess_result ---> |
@@ -578,44 +642,10 @@ reduce(Element, Result, !Runtime) :- | ||
578 | 642 | PreprocessOutput = reduced(Reduced), |
579 | 643 | Result = maybe.ok(Reduced) |
580 | 644 | ; |
581 | - PreprocessOutput = comparison(Cmp, A, B, Tail), | |
582 | - | |
583 | - % Try to inline the result of the comparison, if possible. | |
584 | - % This also allows us to not even compile the side which was not used. | |
585 | - turbolisp.runtime.builtin.comparison_tag(Cmp, Tag), | |
586 | - FallbackResult = maybe.ok(list([atom(Tag)|Tail])), | |
587 | - ( | |
588 | - % Incorrect tail length for comparison builtin. Good luck kid. | |
589 | - ( Tail = [] ; Tail = [_|[]] ; Tail = [_|[_|[_|_]]] ), | |
590 | - Result = FallbackResult | |
591 | - ; | |
592 | - Tail = [Y|[N|[]]], | |
593 | - turbolisp.runtime.builtin.comparison(Cmp, A, B, CmpResult), | |
594 | - ( | |
595 | - CmpResult = turbolisp.runtime.builtin.error(_), | |
596 | - Result = FallbackResult | |
597 | - ; | |
598 | - ( | |
599 | - CmpResult = turbolisp.runtime.builtin.yes, Choice = Y | |
600 | - ; | |
601 | - CmpResult = turbolisp.runtime.builtin.no, Choice = N | |
602 | - ), | |
603 | - | |
604 | - % It should be safe to reduce the result. EIther it is known at | |
605 | - % compile-time, or the comparison will have failed to yield a | |
606 | - % result and we won't be in this arm. | |
607 | - reduce(Choice, ChoiceResult, !Runtime), | |
608 | - ( | |
609 | - ChoiceResult = maybe.error(_), | |
610 | - Result = FallbackResult | |
611 | - ; | |
612 | - ChoiceResult = maybe.ok(_), | |
613 | - Result = ChoiceResult | |
614 | - ) | |
615 | - ) | |
616 | - ) | |
645 | + PreprocessOutput = comparison(_Cmp, _A, _B, _Tail), | |
646 | + Result = maybe.ok(Element) | |
617 | 647 | ; |
618 | - PreprocessOutput = execute(Tag, Tail, Arity), | |
648 | + PreprocessOutput = execute(Tag, Tail, _Arity), | |
619 | 649 | ( if |
620 | 650 | % Do NOT use the results of define ops during reduction. |
621 | 651 | % For let's, the existence of the let will be erased by popping |
@@ -657,18 +687,6 @@ reduce(Element, Result, !Runtime) :- | ||
657 | 687 | Op = turbolisp.runtime.builtin.def |
658 | 688 | ), |
659 | 689 | Result = maybe.ok(list([atom(Tag)|Tail])) |
660 | - else if | |
661 | - find_bind(Tag, Arity, !.Runtime ^ binds, Bind) | |
662 | - then | |
663 | - call_bind(Bind, Tail, CallResult, !Runtime), | |
664 | - | |
665 | - ( | |
666 | - CallResult = maybe.error(Error), | |
667 | - Result = maybe.error(func_error(Tag, Arity, Error)) | |
668 | - ; | |
669 | - CallResult = maybe.ok(_), | |
670 | - Result = CallResult | |
671 | - ) | |
672 | 690 | else |
673 | 691 | Result = maybe.ok(list([atom(Tag)|Tail])) |
674 | 692 | ) |
@@ -697,7 +715,7 @@ reduce(!Element, !Runtime, N, int.plus(N, 1), !Error) :- | ||
697 | 715 | %-----------------------------------------------------------------------------% |
698 | 716 | |
699 | 717 | execute(Element, Result, !Runtime) :- |
700 | - preprocess(reduce, Element, PreprocessResult, !Runtime), | |
718 | + preprocess(execute, Element, PreprocessResult, !Runtime), | |
701 | 719 | ( |
702 | 720 | PreprocessResult = maybe.error(Error), |
703 | 721 | Result = maybe.error(Error) |
@@ -731,14 +749,17 @@ execute(Element, Result, !Runtime) :- | ||
731 | 749 | % Incorrect tail length for comparison builtin. Good luck kid. |
732 | 750 | ( Tail = [] ; Tail = [_|[]] ; Tail = [_|[_|[_|_]]] ), |
733 | 751 | turbolisp.runtime.builtin.comparison_tag(Cmp, Tag), |
734 | - Result = maybe.error(func_error(Tag, 2, "Comparison must have arity of 2")) | |
752 | + Result = maybe.error(func_error(Tag, 4, | |
753 | + string.append( | |
754 | + "Comparison must have arity of 4, was ", | |
755 | + string.from_int(int.plus(list.length(Tail),2))))) | |
735 | 756 | ; |
736 | 757 | Tail = [Y|[N|[]]], |
737 | 758 | turbolisp.runtime.builtin.comparison(Cmp, A, B, CmpResult), |
738 | 759 | ( |
739 | 760 | CmpResult = turbolisp.runtime.builtin.error(Error), |
740 | 761 | turbolisp.runtime.builtin.comparison_tag(Cmp, Tag), |
741 | - Result = maybe.error(func_error(Tag, 2, Error)) | |
762 | + Result = maybe.error(func_error(Tag, 4, Error)) | |
742 | 763 | ; |
743 | 764 | ( |
744 | 765 | CmpResult = turbolisp.runtime.builtin.yes, Choice = Y |
@@ -746,14 +767,11 @@ execute(Element, Result, !Runtime) :- | ||
746 | 767 | CmpResult = turbolisp.runtime.builtin.no, Choice = N |
747 | 768 | ), |
748 | 769 | |
749 | - % It should be safe to reduce the result. EIther it is known at | |
750 | - % compile-time, or the comparison will have failed to yield a | |
751 | - % result and we won't be in this arm. | |
752 | - reduce(Choice, ChoiceResult, !Runtime), | |
770 | + execute(Choice, ChoiceResult, !Runtime), | |
753 | 771 | ( |
754 | 772 | ChoiceResult = maybe.error(Error), |
755 | 773 | turbolisp.runtime.builtin.comparison_tag(Cmp, Tag), |
756 | - Result = maybe.error(func_error(Tag, 2, Error)) | |
774 | + Result = maybe.error(func_error(Tag, 4, Error)) | |
757 | 775 | ; |
758 | 776 | ChoiceResult = maybe.ok(_), |
759 | 777 | Result = ChoiceResult |