cvsuser 04/08/04 23:57:28
Modified: ast node.c
languages/python ast2past.py
languages/python/t/basic 02_expr.t
ops experimental.ops
t/pmc pmc.t
Log:
ast 16 - create code for If, Compare; fix issame
* if - else if ... else
* simple (non-chained) Compare
* fix issame opcode
* new isntsame opcode
Revision Changes Path
1.18 +85 -4 parrot/ast/node.c
Index: node.c
===================================================================
RCS file: /cvs/public/parrot/ast/node.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- node.c 4 Aug 2004 16:27:44 -0000 1.17
+++ node.c 5 Aug 2004 06:57:12 -0000 1.18
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: node.c,v 1.17 2004/08/04 16:27:44 leo Exp $
+$Id: node.c,v 1.18 2004/08/05 06:57:12 leo Exp $
=head1 NAME
@@ -216,6 +216,40 @@
return p->ctx;
}
+static context_type
+ctx_Compare(nodeType *p, context_type ctx)
+{
+ nodeType *op, *left, *right;
+
+ left = CHILD(p);
+ op = left->next;
+
+ /* we don't have general compare ops
+ * XXX not a problem for Python but for statically typed languages
+ * this produces really bad code
+ *
+ * TODO or not WRT "is" and "is not" and native types
+ * we could cheat and emit "eq" for I and N, but that complicates
+ * code generation. STRINGs maybe different anyway
+ */
+ left->ctx = ctx = CTX_PMC;
+ for (; op; op = right->next) {
+ right = op->next;
+ right->ctx = CTX_PMC;
+ /*
+ * TODO bool is ok for If, *but* if e.g. Python prints this value
+ * it has to be converted to a bool object
+ *
+ * The simple and ugly way is to create a new boolean PMC
+ * assign this dest value and return it
+ * Better would be to have True and False static
+ * bool constants around
+ */
+ p->ctx = CTX_BOOL;
+ }
+ return p->ctx;
+}
+
/*
* node creation
*/
@@ -376,7 +410,7 @@
* statement nodes don't have a result
* expression nodes return the result node
*
- * assign returns the rhs so that assigns can get chained together
+ * assign returns the lhs so that assigns can get chained together
* [Python] assign is a statement with possibly multiple LHS
* ast2past.py has converted multiple LHS to chained
* assignment operations so that this matches a more "natural"
@@ -407,7 +441,7 @@
* TODO store in lexicals if needed, i.e. if its not a leaf function
* node
*/
- return rhs;
+ return var;
}
/*
@@ -470,6 +504,47 @@
}
/*
+ * left
+ * Op ... islt, isle, ... issame
+ * right
+ * [ Op
+ * right ... ]
+ *
+ * if a < b < c := a < b && b < c but evaluate b once
+ *
+ */
+static nodeType*
+exp_Compare(Interp* interpreter, nodeType *p)
+{
+ nodeType *op, *left, *right, *dest, *last;
+ Instruction *ins;
+ SymReg *regs[IMCC_MAX_REGS];
+
+ left = CHILD(p);
+ op = left->next;
+ last = right = op->next;
+ /*
+ * first create code for left and right
+ */
+ left = left->expand(interpreter, left);
+ right = right->expand(interpreter, right);
+ /*
+ * then get the current instruction pointer
+ * and append the binary operation
+ */
+ ins = cur_unit->last_ins;
+ dest = IMCC_new_temp_node(interpreter, 'I', &p->loc);
+ p->dest = dest;
+ regs[0] = dest->u.r;
+ regs[1] = left->u.r;
+ regs[2] = right->u.r;
+ insINS(interpreter, cur_unit, ins, op->u.r->name, regs, 3);
+ if (last->next)
+ fatal(1, "ext_Compare", "unimplemented");
+ return dest;
+}
+
+/*
* TODO
*/
static nodeType*
@@ -712,6 +787,7 @@
{ "AssName", create_Name, NULL, NULL, NULL, ctx_Var },
{ "Assign", create_1, exp_Assign, NULL, NULL, NULL },
{ "Binary", create_1, exp_Binary, NULL, NULL, ctx_Binary },
+ { "Compare", create_1, exp_Compare, NULL, NULL, ctx_Compare },
{ "Const", NULL, exp_Const, NULL, dump_Const, ctx_Const },
{ "Defaults", create_1, exp_Defaults, NULL, NULL, NULL },
{ "Function", create_Func, exp_Function, NULL, NULL, NULL },
@@ -735,7 +811,7 @@
{ "_options", create_1, NULL, NULL, NULL, NULL },
{ "version", create_1, exp_default, NULL, NULL, NULL }
-#define CONST_NODE 5
+#define CONST_NODE 6
};
/*
@@ -1015,6 +1091,9 @@
*/
p = check_nodes(interpreter, p);
ctx_default(p, CTX_VOID);
+ if (interpreter->imc_info->debug & DEBUG_AST) {
+ IMCC_dump_nodes(interpreter, p);
+ }
return p->expand(interpreter, p);
}
@@ -1027,6 +1106,8 @@
child = CHILD(p);
IMCC_free_nodes(interpreter, child);
}
+ if (p->dest)
+ mem_sys_free(p->dest);
next = p->next;
mem_sys_free(p);
p = next;
1.7 +14 -1 parrot/languages/python/ast2past.py
Index: ast2past.py
===================================================================
RCS file: /cvs/public/parrot/languages/python/ast2past.py,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- ast2past.py 4 Aug 2004 11:55:25 -0000 1.6
+++ ast2past.py 5 Aug 2004 06:57:16 -0000 1.7
@@ -315,8 +315,21 @@
self.set_lineno(node)
self.begin("Compare(")
self.visit(node.expr) # lhs
+ op_map = {
+ '>' : 'isgt',
+ '>=' : 'isge',
+ '==' : 'iseq',
+ '!=' : 'isne',
+ '<=' : 'isle',
+ '<' : 'islt',
+ 'is' : 'issame',
+ 'is not' : 'TODO',
+ 'in' : 'TODO',
+ 'not in' : 'TODO'
+ }
+
for op, n in node.ops:
- self.append("Op(%s)" % op)
+ self.append("Op(%s)" % op_map[op])
self.visit(n)
self.end(") # Compare")
1.12 +29 -2 parrot/languages/python/t/basic/02_expr.t
Index: 02_expr.t
===================================================================
RCS file: /cvs/public/parrot/languages/python/t/basic/02_expr.t,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- 02_expr.t 4 Aug 2004 16:27:48 -0000 1.11
+++ 02_expr.t 5 Aug 2004 06:57:22 -0000 1.12
@@ -1,9 +1,9 @@
-# $Id: 02_expr.t,v 1.11 2004/08/04 16:27:48 leo Exp $
+# $Id: 02_expr.t,v 1.12 2004/08/05 06:57:22 leo Exp $
use strict;
use lib '../../lib';
-use Parrot::Test tests => 16;
+use Parrot::Test tests => 20;
sub test {
language_output_is('python', $_[0], '', $_[1]);
@@ -86,6 +86,33 @@
print "ok"
CODE
+test( <<'CODE', 'if Ic < Ic' );
+if 1 < 2:
+ print "ok"
+CODE
+
+test( <<'CODE', 'if Ic < P' );
+a = 1
+if a < 2:
+ print "ok"
+CODE
+
+test( <<'CODE', 'if P < P' );
+a = 1
+b = 2
+if a < b:
+ print "ok"
+CODE
+
+test( <<'CODE', 'if P is P' );
+a = b = 1
+c = 2
+if a is b:
+ print "ok"
+if a is c:
+ print "nok"
+CODE
+
SKIP: {
skip("Not yet", 3);
1.9 +12 -2 parrot/ops/experimental.ops
Index: experimental.ops
===================================================================
RCS file: /cvs/public/parrot/ops/experimental.ops,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- experimental.ops 3 Aug 2004 21:59:54 -0000 1.8
+++ experimental.ops 5 Aug 2004 06:57:25 -0000 1.9
@@ -146,12 +146,22 @@
=item B<issame>(out INT, in PMC, in PMC)
-Sets $1 to 1 or 0, dependig on the identity of the 2 objects.
+Sets $1 to 1 or 0, depending on the identity of the 2 objects.
+The identity is the PMCs memory address.
+
+=item B<isntsame>(out INT, in PMC, in PMC)
+
+Sets $1 to 0 or 1, depending on the identity of the 2 objects.
=cut
inline op issame(out INT, in PMC, in PMC) {
- $1 = &$2 == &$3;
+ $1 = $2 == $3;
+ goto NEXT();
+}
+
+inline op isntsame(out INT, in PMC, in PMC) {
+ $1 = $2 != $3;
goto NEXT();
}
1.92 +21 -2 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.91
retrieving revision 1.92
diff -u -w -r1.91 -r1.92
--- pmc.t 3 Aug 2004 18:23:41 -0000 1.91
+++ pmc.t 5 Aug 2004 06:57:28 -0000 1.92
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.91 2004/08/03 18:23:41 scog Exp $
+# $Id: pmc.t,v 1.92 2004/08/05 06:57:28 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 93;
+use Parrot::Test tests => 94;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -2586,4 +2586,23 @@
ok 5
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "issame");
+ new P0, .Undef
+ new P1, .Undef
+ set P1, P0
+ issame I0, P0, P1
+ print I0
+ isntsame I0, P0, P1
+ print I0
+ new P2, .Undef
+ issame I0, P0, P2
+ print I0
+ isntsame I0, P0, P2
+ print I0
+ print "\n"
+ end
+CODE
+1001
+OUTPUT
+
1;
