Author: leo
Date: Wed Aug 3 02:39:30 2005
New Revision: 8771
Added:
branches/leo-ctx5/languages/lazy-k/cat.lazy (props changed)
- copied unchanged from r8770, trunk/languages/lazy-k/cat.lazy
Modified:
branches/leo-ctx5/MANIFEST
branches/leo-ctx5/PLATFORMS
branches/leo-ctx5/dynclasses/pyboolean.pmc
branches/leo-ctx5/dynclasses/pystring.pmc
branches/leo-ctx5/languages/lazy-k/lazy.pir
branches/leo-ctx5/languages/tcl/tcl.pl
Log:
merge -r8764:8770 from trunk
Modified: branches/leo-ctx5/MANIFEST
==============================================================================
--- branches/leo-ctx5/MANIFEST (original)
+++ branches/leo-ctx5/MANIFEST Wed Aug 3 02:39:30 2005
@@ -1028,6 +1028,7 @@ languages/jako/t/assign.jako
languages/jako/t/data_decl.jako [jako]
languages/lazy-k/README [lazy-k]
languages/lazy-k/calc.lazy [lazy-k]
+languages/lazy-k/cat.lazy [lazy-k]
languages/lazy-k/lazy.pir [lazy-k]
languages/lazy-k/powers2.lazy [lazy-k]
languages/lazy-k/test.sh [lazy-k]
Modified: branches/leo-ctx5/PLATFORMS
==============================================================================
--- branches/leo-ctx5/PLATFORMS (original)
+++ branches/leo-ctx5/PLATFORMS Wed Aug 3 02:39:30 2005
@@ -35,7 +35,7 @@ win32-bcc
win32-cygwin_1.5.11_1 Y Y - Y*5 Y Y Y 20041006
win32-icl_8.0.48 - Y - - - Y Y/2
win32-mingw-gcc3.2.3 Y Y Y - - Y Y/81 Y 20050603
-win32-msvc_7.1 - Y - - - Y Y/77 20050701
+win32-msvc_7.1 - Y - - - Y Y 20050802
- ... no
Y ... yes
Modified: branches/leo-ctx5/dynclasses/pyboolean.pmc
==============================================================================
--- branches/leo-ctx5/dynclasses/pyboolean.pmc (original)
+++ branches/leo-ctx5/dynclasses/pyboolean.pmc Wed Aug 3 02:39:30 2005
@@ -159,6 +159,18 @@ Returns the negated value of the boolean
/*
+=item C<void set_bool (INTVAL value)>
+
+=cut
+
+*/
+
+ void set_bool (INTVAL value) {
+ PMC_int_val(SELF) = (value != 0);
+ }
+
+/*
+
=item C<void set_integer_native (INTVAL value)>
=cut
Modified: branches/leo-ctx5/dynclasses/pystring.pmc
==============================================================================
--- branches/leo-ctx5/dynclasses/pystring.pmc (original)
+++ branches/leo-ctx5/dynclasses/pystring.pmc Wed Aug 3 02:39:30 2005
@@ -304,7 +304,7 @@ Returns pythons string repr (w/o any esc
i_q = -1;
}
- if (PObj_get_FLAGS(s) & PObj_private7_FLAG)
+ if (s->charset == Parrot_binary_charset_ptr)
repr = string_copy(INTERP, const_string(INTERP, "u'"));
else
repr = string_copy(INTERP, q);
Modified: branches/leo-ctx5/languages/lazy-k/lazy.pir
==============================================================================
--- branches/leo-ctx5/languages/lazy-k/lazy.pir (original)
+++ branches/leo-ctx5/languages/lazy-k/lazy.pir Wed Aug 3 02:39:30 2005
@@ -23,11 +23,27 @@ And a lot of comments in the source - so
=cut
+
.sub _main @MAIN
.param pmc argv
.local int argc
.local pmc in
+
+ # define constants for he various kinds of expressions
+ .globalconst int expA = 1
+ .globalconst int expI = 2
+ .globalconst int expI1 = 3
+ .globalconst int expK = 4
+ .globalconst int expK1 = 5
+ .globalconst int expS = 6
+ .globalconst int expS1 = 7
+ .globalconst int expS2 = 8
+ .globalconst int expLR = 9
+ .globalconst int expInc = 10
+ .globalconst int expNum = 11
+
argc = argv
+ # TODO -e, chained arguments
if argc > 1 goto open_file
in = getstdin
goto run
@@ -42,7 +58,7 @@ open_file:
exit 1
run:
.local pmc prog, e
- $P0 = getinterp
+
create_globals()
e = global "I"
prog = parse(in)
@@ -51,10 +67,13 @@ run:
.local pmc lr, NUL
null NUL
- lr = new_expr('LR', NUL, NUL)
+ lr = new_expr(expLR, NUL, NUL)
e = new_apply(e, lr)
## deparse_e(e)
## trace 15
+
+ # convert results from a list of church numbers to 8-bit chars
+ # cchar >= 256 means exit = ccchar - 256
loop:
$P0 = car(e)
$I0 = church2int($P0)
@@ -67,13 +86,14 @@ put:
goto loop
.end
+# append expressions so that they are run in sequence
.sub compose
.param pmc f
.param pmc g
.local pmc k1f, NUL
null NUL
- k1f = new_expr('K1', f, NUL)
- .return new_expr('S2', k1f, g)
+ k1f = new_expr(expK1, f, NUL)
+ .return new_expr(expS2, k1f, g)
.end
.sub append
@@ -82,6 +102,8 @@ put:
.return compose(n, old)
.end
+# convert expression (which sould be a churn numeral to a native int
+# this is done by evaluating lambda (n) (Inc n 0)
.sub church2int
.param pmc church
@@ -99,6 +121,7 @@ err:
exit 3
.end
+# get head of list
.sub car
.param pmc list
.local pmc k
@@ -106,6 +129,7 @@ err:
.return new_apply(list, k)
.end
+# get tail of list
.sub cdr
.param pmc list
.local pmc ki
@@ -113,32 +137,34 @@ err:
.return new_apply(list, ki)
.end
+# create globals for commonly used expressions and
+# initialize the first 2 church numerals
.sub create_globals
.local pmc e, NUL, K, S, KS, I, KI
null NUL
- K = new_expr('K', NUL, NUL)
+ K = new_expr(expK, NUL, NUL)
global "K" = K
- S = new_expr('S', NUL, NUL)
+ S = new_expr(expS, NUL, NUL)
global "S" = S
- I = new_expr('I', NUL, NUL)
+ I = new_expr(expI, NUL, NUL)
global "I" = I
- KI = new_expr('K1', I, NUL)
+ KI = new_expr(expK1, I, NUL)
global "KI" = KI
- e = new_expr('S1', I, NUL)
+ e = new_expr(expS1, I, NUL)
global "SI" = e
- KS = new_expr('K1', S, NUL)
+ KS = new_expr(expK1, S, NUL)
global "KS" = KS
- e = new_expr('K1', K, NUL)
+ e = new_expr(expK1, K, NUL)
global "KK" = e
- e = new_expr('S2', KS, K)
+ e = new_expr(expS2, KS, K)
global "SKSK" = e
- e = new_expr('S2', I, KS)
+ e = new_expr(expS2, I, KS)
global "SIKS" = e
- e = new_expr('Inc', NUL, NUL)
+ e = new_expr(expInc, NUL, NUL)
global "Inc" = e
$P0 = new .Integer
- e = new_expr('Num', $P0, NUL)
+ e = new_expr(expNum, $P0, NUL)
global "Zero" = e
.local pmc cache
@@ -150,8 +176,9 @@ err:
.end
+# create a new expression of the given type
.sub new_expr
- .param string type
+ .param int type
.param pmc lhs
.param pmc rhs
.local pmc expr
@@ -163,12 +190,15 @@ err:
.return (expr)
.end
+# create a new apply expr
.sub new_apply
.param pmc lhs
.param pmc rhs
- .return new_expr('A', lhs, rhs)
+ .return new_expr(expA, lhs, rhs)
.end
+# parse from an IO handle
+# only 'ski currently
.sub parse
.param pmc io
@@ -195,7 +225,6 @@ not_k:
unless ch == 's' goto not_s
.return (S)
not_s:
-not_e:
unless ch == '#' goto not_comment
swallow:
ch = read io, 1
@@ -212,20 +241,25 @@ not_comment:
exit 1
.end
+# apply identy which just returns it's rhs
+# this can be done in a loop, if we have a sequence of I1
.sub drop_i1
.param pmc expr
- .local pmc type
- .local string ts
+ .local int type
loop:
type = expr[0]
- ts = type
- if ts != 'I1' goto ret_e
+ if type != expI1 goto ret_e
expr = expr[1]
goto loop
ret_e:
.return (expr)
.end
+# convert a native int to a church numeral expression
+# the first 2 are pregenerated, the next ones are created
+# recursively by prepending ``s``s`ksk
+# we could of course create short sequences with multiplication
+# and powers of n
.sub int2church
.param int i
@@ -243,19 +277,19 @@ ok:
sksk = global "SKSK"
$I0 = i - 1
cm1 = int2church($I0)
- e = new_expr('S2', sksk, cm1)
+ e = new_expr(expS2, sksk, cm1)
cached[i] = e
ret:
.return (e)
.end
+# return native integer of a Num expression or -1 on error
.sub to_number
.param pmc expr
- .local pmc type, arg1
- .local string ts
+ .local pmc arg1
+ .local int type
type = expr[0]
- ts = type
- if ts != 'Num' goto ret1
+ if type != expNum goto ret1
$P0 = expr[1]
$I0 = $P0
.return ($I0)
@@ -263,52 +297,53 @@ ret1:
.return (-1)
.end
+# apply (f g)
+# this works inplace using the fact of referential integrity of Lazy-k
.sub apply
.param pmc expr
- .local pmc type, lhs, rhs, arg1, arg2, NUL
- .local string ts
+ .local pmc lhs, rhs, arg1, arg2, NUL
+ .local int type
arg1 = expr[1]
arg2 = expr[2]
lhs = arg1
rhs = drop_i1(arg2)
null NUL
type = lhs[0]
- ts = type
- unless ts == 'K' goto not_k
- expr[0] = 'K1'
+ unless type == expK goto not_k
+ expr[0] = expK1
expr[1] = rhs
expr[2] = NUL
.return()
not_k:
- unless ts == 'K1' goto not_k1
- expr[0] = 'I1'
+ unless type == expK1 goto not_k1
+ expr[0] = expI1
$P0 = lhs[1]
expr[1] = $P0
expr[2] = NUL
.return()
not_k1:
- unless ts == 'I' goto not_i
- expr[0] = 'I1'
+ unless type == expI goto not_i
+ expr[0] = expI1
expr[1] = rhs
expr[2] = NUL
.return()
not_i:
- unless ts == 'S' goto not_s
- expr[0] = 'S1'
+ unless type == expS goto not_s
+ expr[0] = expS1
expr[1] = rhs
expr[2] = NUL
.return()
not_s:
- unless ts == 'S1' goto not_s1
- expr[0] = 'S2'
+ unless type == expS1 goto not_s1
+ expr[0] = expS2
$P0 = lhs[1]
expr[1] = $P0
expr[2] = rhs
.return()
not_s1:
- unless ts == 'LR' goto not_lr
- lhs[0] = 'S2'
+ unless type == expLR goto not_lr
+ lhs[0] = expS2
.local pmc cc, k1c, s2ik1, i, io
.local string s
io = getstdin
@@ -320,17 +355,17 @@ not_s1:
eof:
cc = int2church($I0)
i = global "I"
- k1c = new_expr('K1', cc, NUL)
- s2ik1 = new_expr('S2', i, k1c)
+ k1c = new_expr(expK1, cc, NUL)
+ s2ik1 = new_expr(expS2, i, k1c)
lhs[1] = s2ik1
- $P0 = new_expr('LR', NUL, NUL)
- $P1 = new_expr('K1', $P0)
+ $P0 = new_expr(expLR, NUL, NUL)
+ $P1 = new_expr(expK1, $P0)
lhs[2] = $P1
goto s2
not_lr:
- unless ts == 'S2' goto not_s2
+ unless type == expS2 goto not_s2
s2:
- ## expr[0] = 'A'
+ ## expr[0] = expA
$P0 = lhs[1]
$P1 = new_apply( $P0, rhs)
expr[1] = $P1
@@ -339,7 +374,7 @@ s2:
expr[2] = $P2
.return()
not_s2:
- unless ts == 'Inc' goto not_inc
+ unless type == expInc goto not_inc
rhs = eval(rhs)
$I0 = to_number(rhs)
inc $I0
@@ -349,29 +384,63 @@ not_s2:
num_ok:
$P0 = new Integer
$P0 = $I0
- expr[0] = 'Num'
+ expr[0] = expNum
expr[1] = $P0
expr[2] = NUL
.return()
not_inc:
- unless ts == 'Num' goto not_num
+ unless type == expNum goto not_num
printerr "invalid apply of number\n"
exit 1
not_num:
printerr "unknown expression: '"
- printerr ts
+ printerr type
printerr "'\n"
exit 1
.return()
.end
+# evaluate expression
+# this works inplace using the fact of referential integrity of Lazy-k
+.sub eval
+ .param pmc expr
+ .local pmc cur, arg1, next, prev, NUL
+ .local int type
+ ##deparse_e(expr)
+ cur = expr
+ null prev
+ null NUL
+loop:
+ cur = drop_i1(cur)
+lpa:
+ type = cur[0]
+ if type != expA goto not_a
+ next = cur[1]
+ next = drop_i1(next)
+ cur[1] = prev
+ prev = cur
+ cur = next
+ goto lpa
+not_a:
+ unless_null prev, isnt_nul
+ .return (cur)
+isnt_nul:
+ next = cur
+ cur = prev
+ prev = cur[1]
+ cur[1] = next
+ apply(cur)
+ goto loop
+ .return (NUL)
+.end
+
+# debug helper - print string rep of expr
.sub deparse
.param pmc expr
- .local pmc type, arg1, arg2
- .local string ts
+ .local pmc arg1, arg2
+ .local int type
type = expr[0]
- ts = type
- unless ts == 'A' goto not_a
+ unless type == expA goto not_a
print "("
arg1 = expr[1]
deparse(arg1)
@@ -381,33 +450,33 @@ not_num:
print ")"
.return()
not_a:
- unless ts == 'K' goto not_k
+ unless type == expK goto not_k
print "K"
.return()
not_k:
- unless ts == 'I' goto not_i
+ unless type == expI goto not_i
print "I"
.return()
not_i:
- unless ts == 'K1' goto not_k1
+ unless type == expK1 goto not_k1
print "[K"
arg1 = expr[1]
deparse(arg1)
print "]"
.return()
not_k1:
- unless ts == 'I1' goto not_i1
+ unless type == expI1 goto not_i1
print "[I"
arg1 = expr[1]
deparse(arg1)
print "]"
.return()
not_i1:
- unless ts == 'S' goto not_s
+ unless type == expS goto not_s
print "S"
.return()
not_s:
- unless ts == 'S1' goto not_s1
+ unless type == expS1 goto not_s1
print "[S"
arg1 = expr[1]
deparse(arg1)
@@ -415,7 +484,7 @@ not_s:
.return()
not_s1:
- unless ts == 'S2' goto not_s2
+ unless type == expS2 goto not_s2
print "[s"
arg1 = expr[1]
deparse(arg1)
@@ -425,64 +494,32 @@ not_s1:
print "]"
.return()
not_s2:
- unless ts == 'LR' goto not_lr
+ unless type == expLR goto not_lr
print "R"
.return()
not_lr:
- unless ts == 'Inc' goto not_inc
+ unless type == expInc goto not_inc
print "I"
.return()
not_inc:
- unless ts == 'Num' goto not_num
+ unless type == expNum goto not_num
$I0 = expr[1]
print $I0
.return()
not_num:
printerr "unknown expression: '"
- printerr ts
+ printerr type
printerr "'\n"
exit 1
.return()
.end
+# debug print string rep of expr
.sub deparse_e
.param pmc expr
deparse(expr)
print "\n"
.end
-.sub eval
- .param pmc expr
- .local pmc cur, arg1, type, next, prev, NUL
- .local string ts
- ##deparse_e(expr)
- cur = expr
- null prev
- null NUL
-loop:
- cur = drop_i1(cur)
-lpa:
- type = cur[0]
- ts = type
- if ts != 'A' goto not_a
- next = cur[1]
- next = drop_i1(next)
- cur[1] = prev
- prev = cur
- cur = next
- goto lpa
-not_a:
- unless_null prev, isnt_nul
- .return (cur)
-isnt_nul:
- next = cur
- cur = prev
- prev = cur[1]
- cur[1] = next
- apply(cur)
- goto loop
- .return (NUL)
-.end
-
.include "library/dumper.imc"
# vim: ft=imc sw=4:
Modified: branches/leo-ctx5/languages/tcl/tcl.pl
==============================================================================
--- branches/leo-ctx5/languages/tcl/tcl.pl (original)
+++ branches/leo-ctx5/languages/tcl/tcl.pl Wed Aug 3 02:39:30 2005
@@ -58,19 +58,18 @@ $rules = <<'EOH';
.sub "_load_grammar"
.local pmc p6rule_compile
p6rule_compile = find_global "PGE", "p6rule"
-
- .local string grammar
+
+ .local string grammar
grammar = "_Tcl_Rules" #xxx should probably not hardcode this.
EOH
my $rule = join("",<RULES>);
$rule =~ s/\n//g;
-$rule =~ s/\#rule\s+(\w+)\s*{(.*?)};//g;
-
-while ($rule =~ m/rule\s+(\w+)\s*{(.*?)};/g) {
+while ($rule =~ m/rule\s+(\w+)\s*{\s*(.*?)\s*};?/g) {
my $rule_name = $1;
my $rule_def = $2;
+ $rule_def =~ s:\s+: :g; # remove extra whitespace
$rule_def =~ s:\\:\\\\:g;
$rule_def =~ s:":\\":g;
