cvsuser 03/07/10 16:56:12
Modified: languages/plot/t plot.t
languages/plot plot.pasm
Log:
Okay, we have the beginnings of the empty list... Not exactly exciting yet...
Revision Changes Path
1.2 +7 -18 parrot/languages/plot/t/plot.t
Index: plot.t
===================================================================
RCS file: /cvs/public/parrot/languages/plot/t/plot.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- plot.t 10 Jul 2003 18:28:17 -0000 1.1
+++ plot.t 10 Jul 2003 23:56:11 -0000 1.2
@@ -3,27 +3,16 @@
use lib '../../../lib';
use Parrot::Test tests => 1;
use Test::More;
-
-
output_is(<<'CODE', <<'OUTPUT', "Testing the empty list");
.include "../plot.pasm"
- find_global P5, "()"
- set S16, P5[0]
- eq S16, "*nil*", OK_1
- print "not "
-OK_1: print "ok 1\n"
-
- find_lex P0, "eval"
+ find_lex P0, "nil?"
+ find_lex P5, "()"
invokecc
- set S17, P5[0]
- eq S17, "*nil*", OK_2
- print "not"
-OK_2: print "ok 2\n"
- nilp P5, OK_3
- print "not "
-OK_3: print "ok 3\n"
+ find_lex P0, "print"
+ invokecc
+ print "\n"
+ end
CODE
-ok 1
-ok 2
+#t
OUTPUT
1.2 +111 -12 parrot/languages/plot/plot.pasm
Index: plot.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/plot/plot.pasm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- plot.pasm 10 Jul 2003 18:28:20 -0000 1.1
+++ plot.pasm 10 Jul 2003 23:56:12 -0000 1.2
@@ -1,21 +1,120 @@
# Plot
# Copyright YAS -- will have more detail later...
+.macro cs_case(S, L)
+ newsub P16, .Sub, .L
+ store_lex -1, .S, P16
+.endm
+
+.macro cs_falsecase(S)
+ newsub P16, .Sub, _ret_scheme_f
+ store_lex -1, .S, P16
+.endm
+
+.macro cs_truecase(S)
+ newsub P16, .Sub, _ret_scheme_t
+ store_lex -1, .S, P16
+.endm
+
+.macro def_self_eval (P,N,L)
+ new_pad 1
+ newsub .P, .Closure, _self_eval
+ store_lex -1, "eval", .P
+ newsub .P, .Closure, .$DISPATCH
+ store_lex 0, .N, .P
+ branch .$END
+.local $DISPATCH:
+ save P0
+ find_lex P0, S5
+ invoke
+.local $ERR:
+ throw P0
+.local $END:
+.endm
-# Making ()/nil
- new P16, .PerlArray
- set P16[0], "*nil*"
- store_global "()", P16
+ new_pad 0
-.macro nilp ( T, L)
+# Making (p)/nil
+ .def_self_eval(P16, "()", nil)
+ .cs_case("print", _nil_print)
+ .cs_case("car", _self_eval)
+ .cs_case("cdr", _self_eval)
+ .cs_truecase("nil?")
+ pop_pad
+ branch NIL_END
+
+_nil_print:
+ print "'()"
+ find_lex P5, "#t"
+ invoke P1
+_self_eval:
+ restore P5
+ invoke P1
-# Set up eval
- new_pad 0
- newsub P16, .Sub, eval
- store_lex 0, "eval", P16
- branch EVAL_END
+NIL_END:
-eval:
+SCHEME_T:
+ .def_self_eval(P16, "#t", nil)
+ .cs_case("print", _scheme_t_print)
+ .cs_case("car", _scheme_error)
+ .cs_case("cdr", _scheme_error)
+ .cs_falsecase("nil?")
+ pop_pad
+ branch SCHEME_T_END
+
+_scheme_t_print:
+ print "#t"
+ restore P5
invoke P1
-EVAL_END:
\ No newline at end of file
+_ret_scheme_t:
+ find_lex P5, "#t"
+ invoke P1
+
+SCHEME_T_END:
+
+SCHEME_F:
+ .def_self_eval(P16, "#f", nil)
+ .cs_case("print", _scheme_f_print)
+ .cs_case("car", _scheme_error)
+ .cs_case("cdr", _scheme_error)
+ .cs_falsecase("nil?")
+ pop_pad
+ branch SCHEME_F_END
+
+_scheme_f_print:
+ print "#f"
+ find_lex P5, "#t"
+ invoke P1
+
+_ret_scheme_f:
+ find_lex P5, "#f"
+ invoke P1
+
+SCHEME_F_END:
+
+.macro make_dispatcher( S )
+ newsub P16, .Closure, .$DISPATCH
+ store_lex 0, .S, P16
+ branch .$END
+.local $DISPATCH:
+ set P0, P5
+ set P2, P5
+ set S5, .S
+ invoke
+.local $END:
+.endm
+
+ .make_dispatcher("nil?")
+ .make_dispatcher("print")
+ .make_dispatcher("println")
+ .make_dispatcher("car")
+ .make_dispatcher("cdr")
+
+branch END
+
+_scheme_error:
+ find_lex P5, "#f"
+ print "Oopsie!"
+
+END:
