Author: leo
Date: Tue Aug 2 06:53:59 2005
New Revision: 8768
Modified:
trunk/languages/lazy-k/lazy.pir
Log:
Lazy-k cleanup; comments
* use integers for denoting expressions instead of string
* add some comments
Modified: trunk/languages/lazy-k/lazy.pir
==============================================================================
--- trunk/languages/lazy-k/lazy.pir (original)
+++ trunk/languages/lazy-k/lazy.pir Tue Aug 2 06:53:59 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
@@ -212,20 +242,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 +278,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 +298,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 +356,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 +375,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 +385,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 +451,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 +485,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 +495,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:
