Author: leo Date: Mon Aug 1 15:32:52 2005 New Revision: 8762 Added: trunk/languages/lazy-k/ trunk/languages/lazy-k/README trunk/languages/lazy-k/calc.lazy (contents, props changed) trunk/languages/lazy-k/lazy.pir (contents, props changed) trunk/languages/lazy-k/powers2.lazy (contents, props changed) trunk/languages/lazy-k/test.sh (contents, props changed) Modified: trunk/MANIFEST trunk/languages/LANGUAGES.STATUS Log: More FP fun - Lazy-k
* translate most of lazy.cpp to pir * not finished but it's backuped now :-) * it seems to expose a problem with (I guess) nested tailcalls in branches/leo-ctx5 - so it's a nice test too Modified: trunk/MANIFEST ============================================================================== --- trunk/MANIFEST (original) +++ trunk/MANIFEST Mon Aug 1 15:32:52 2005 @@ -1025,6 +1025,11 @@ languages/jako/string.jako languages/jako/sys.jako [jako] languages/jako/t/assign.jako [jako] languages/jako/t/data_decl.jako [jako] +languages/lazy-k/README [lazy-k] +languages/lazy-k/calc.lazy [lazy-k] +languages/lazy-k/lazy.pir [lazy-k] +languages/lazy-k/powers2.lazy [lazy-k] +languages/lazy-k/test.sh [lazy-k] languages/lisp/t/test.l [lisp] languages/lisp/lisp/logic.l [lisp] languages/lisp/lisp/core.l [lisp] Modified: trunk/languages/LANGUAGES.STATUS ============================================================================== --- trunk/languages/LANGUAGES.STATUS (original) +++ trunk/languages/LANGUAGES.STATUS Mon Aug 1 15:32:52 2005 @@ -87,6 +87,13 @@ S: generation was written, causing some M: Yes V: 0.0.11 +N: lazy-k +A: Leopold Tötsch +D: lazy-k is a pure functional programming language according to the +D: SKI calculus. +W: http://homepages.cwi.nl/~tromp/cl/lazy-k.html +V: 0.2.2 + N: m4 A: Bernhard Schmalhofer D: Port of GNU m4 to PIR @@ -119,7 +126,7 @@ D: variables, nested words and classes a D: compile-time and run-time lexical word, class and variable scopes. S: Under development; S: Not in Parrot CVS -W: http://www.daca.net:8080/Parakeet-0.1.tgz +W: http://www.daca.net:8080/Parakeet-0.1.tgz V: 0.0.11 N: parrot_compiler @@ -201,7 +208,7 @@ N: unlamba A: Leopold Tötsch D: unlambda is a pure functional programming language with mostly eager D: evaluation following the SKI calculus (+ a few extensions) -S: Errors on HEAD branch, which will go away after complete merge of +S: Errors on HEAD branch, which will go away after complete merge of S: Leo's branch, W: http://www.madore.org/~david/programs/unlambda/ V: 0.2.2 Added: trunk/languages/lazy-k/README ============================================================================== --- (empty file) +++ trunk/languages/lazy-k/README Mon Aug 1 15:32:52 2005 @@ -0,0 +1,17 @@ +This is an incomplete implementation of Lazy-k - only 'ski parsing is +done currently. + +Lazy K programs live in the same timeless Platonic realm as mathematical +functions, what the Unlambda page calls "the blessed realm of the pure untyped +lambda calculus." + +There is no special syntax for IO, lazy-k programs get their input (from stdin) +as a list of church numerals and create a list of these, which is converted to +8-bit characters as output of the computation, 256 is serving as EOF. + +References: + +http://homepages.cwi.nl/~tromp/cl/lazy-k.html +http://en.wikipedia.org/wiki/Lazy_K_programming_language + +The 2 example files are copyrighted GPL by the author of Lazy-k. Added: trunk/languages/lazy-k/calc.lazy ============================================================================== --- (empty file) +++ trunk/languages/lazy-k/calc.lazy Mon Aug 1 15:32:52 2005 @@ -0,0 +1,95 @@ +# Arbitrary-precision calculator. +# Copyright 2002 Ben Rudiak-Gould. Distributed under the GPL. + +``s`k```sii``s`k`s`k`````sii```sii``s``s`kski``s`k`sik`k`k```sii```sii``s``s +`kski``s`k`s``s``si`kk`k``s`k`sik``s`k`s`kk``s`k`s```sii``s`k``sii``s``s`ks` +`s`k`s`ks``s`k`s`k`s`ks``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`k`s`ks`` +s``s`ks``s`kk``s`ks``s`k`s`ks``s`k`s`kk``s`k`s`ks``s`k`s`k`s`ks``s``s`ks``s` +kk``s`ks``s`k`s`ks``s`k`s`k`s`k``sii``s``s`ks``s`kk``s`ks``s`kk``s`ks``s`k`s +`ks``s`k`s`k`s`ks``s``s`ks``s`kk``s`ks``s`k`s`ks``s`k`s`kk``s`k`s`ks``s``s`k +s``s`kk``s`ks``s`k`s`k``sii``s``s`ks``s`kk``s`ks``s`kk``s`ks``s`k`s`ks``s`k` +s`kk``s``s`ks``s`k`s`ks``s`k`s``s`ks``s`kk``s`k``si`kk``s``s``si`kk`k``si`k` +ki`k````s``s`ksk```sii``s``s`kski````s``s`ksk``s``s`kski``s``s`kski``s`k`s`` +si`k`kik``s``si`kk`k```sii``s`k``s`k`s``si`k`kik``sii``s``s`ks``s`k`s`ks``s` +k`s`kk``s``s`ks``s`kk``sii`k``si`k`ki`k`k``s``s`ks``s`k`s`ks``s`k`s`k`s`ks`` +s`k`s``s`ks``s`kk``s`ks``s`kk``s`k``si`kk``s``s``si`kk`k``si`k`ki`k```````s` +`siii``s``s`kski`s``s`ksk```s``s`kski``s``s`ksk```sii``s``s`kski``s`k`s``si` +k`kik``s``si`kk`k```sii``s`k``s`k`s``si`k`kik``sii``s``s`ksk`k``si`k`ki`k`k` +k`k``s``si`k``s``s`ksk``s`k``s``s`kski`````sii``s``s`kski`s``s`ksk```sii``s` +`s`ksk``s``s`kski`k`k```sii```sii``s``s`kski`k``s``s`ks``s`kk``s``s`ks``s``s +`ks``s`k`s``siik`k`k```sii``s`k``s`k`s``si`k`kik``sii`k`k`ki`k``s`k`s``s`ks` +`s`k`s`ks``s`k`s`k`s`ks``s`k`s``s`ks``s`kk``s`ks``s`kk``s`k``si`kk``s``s``si +`kk`k``si`k`ki`k````s``s`ksk``s``s`kski````s``siii``s``s`kski``s`k`s``si`k`k +ik````s``s`kski```s``s`ksk```sii``s``s`kski``s`k`s``si`kkk```sii``s`k``s`k`s +``si`k`kik``sii``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk``s``s`ks``s`k +`s`ks``s`k`s`kk``s``s`ks``s`kk``sii`k``si`k`ki`k``s``s`ks``s`kk``s`ks``s`k`s +i``s`kk``s`k``si`kk``s``s``si`kk`k``si`k`ki`k````s``s`ksk``s``s`kski````s``s +iii``s``s`kski``s`k`s``si`k`kik````sii``s`k`s``s`ks``s`k`sik``s`k`s`kk``s``s +`ks``s`kk``sii`k`s``s`ksk`ki`kk`k`k`k`s``s`kskk`k``s`k`s`kk``s``s`ks``s`k`s` +ks``s`k`s`k`s`ks``s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s``s`k +s``s`kk``s`ks``s`kk``s`k``si`kk``s``s``si`kk`k``si`k`ki`k````s``s`ksk``s`k`` +s``s`ksk``s``s`kski`````sii``s``s`kski`s``s`ksk```sii``s``s`ksk``s``s`kski`` +s`k`s``si`k`kik``s``si`kk`k```sii``s`k``s`k`s``si`k`kik``sii``s`k`s``s`ks``s +`kk``s`ks``s`k`s`ks``s`k`s`kk``s`k`s`ks``s`k`s`kk``s``s`ks``s`kk``sii`k``si` +k`ki``s`kk``s`k`s`kk``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`k`s`ks``s`k +`s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`k`s`kk``s`k`s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s +`k`s`kk``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk``s`k`s`k`s`ks``s`k`s` +k`s`k`s`ks``s`k`s``s`ks``s`kk``s`ks``s`k`s`ks`s`kk``s`kk``s`k`s`kk``s`k`s`k` +`sii``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`k`s``s``s`ksk`kk``s`k`s`k`s +`k`s``s``s`ks``s``s`ks``si`k``s``s`ks``s`k`s`ks``s`k`s`kk``s``s`ksk`k``si`k` +ki`k``si`k`s``s`ksk`k`k`ki`k`k`ki``s`k`s`k`s`kk``s``s`ks``s`k`s`ks``s`k`s`kk +``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk``s`k`s`k`si`s`kk``s`kk``s`k`s`kk``s`` +s`ks``s`kk``s`ks``s`kk``ss`ki`k``sii`k`k`k`k``s``si`ki`k```sii``s`k``s`k`s`` +si`k`kik``sii`k`k`k``s`kk``s`k`s`k`s``s`ksk``s`ksk`k`k`k`k`k``s``s`ks``s``s` +ks``s`k`s``s``si`k``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s``s`ks``s`k`s`ks``s`k` +s`kk``s`k`s`ks``s`k`s`kk``s``s`ksk`k``si`k`ki`k``s`k`s``s`ks``s`kk``si`k`s`` +s`ksk``s`kk``s`k`s``s`ksk```ss`si`kk`k`k`k`s`k``s`k``s``s`kski``s``s`ksk```s +ii``s``s`kski`k`kkk`k`k`ki`k`ki`k`ki`kk`k```ss`s``s`ks``s`k`s`ks``s`k`s`k`s` +ks``s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s``s`ks``s`kk``s`ks` +`s`kk``s`k``si`kk``s``s``si`kk`k``si`k`ki`k````s``s`kski`````s``s`ksk```sii` +`s``s`kski`s``s`ksk```s``siii``s``s`kski``s`k`s``si`k`kik``s``si`kk`k```sii` +`s`k``s`k`s``si`k`kik``sii``s``s`ks``s`kk``s`ks``s`kk``s`ks``s`k`s`ks``s`k`s +`kk``s`k`s`ks``s`k`s`kk``s``s`ks``s`kk``sii`k``si`k`ki`k``s`k`s`kk``s``s`ks` +`s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk``s`k`s`k`s`ks``s`k`s`k`s`k`s`ks``s`k`s +`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`k`s`kk``s``s`ks``s`kk``s`ks``s`kk``s`ks``s`k` +s`ks`s`kk`k`s`kk`k`k`k``s`kk``s`kk``si`k`s``s`ksk`kk`k``s`k`s`kk``s`k`s`kk`` +s`k`s`kk``s`k`s`k`s`k``sii``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`k`s`k +s``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk``s`k`s`k`s`ks``s`k`s``s`ks` +`s`kk``s`ksk``s`kk``s``s`ks``s`k`s`ks``s``s`ks``s`kk``s`ks``s`k`s`k``sii``s` +k`s`k`s``s`ks``s`k`s`ks``s`k`s`kk``s`k`s`k`s``s``s`ks``s`kk``s`ks``s`k`si``` +ss`si`kk`kk``s``s`ks``s`k`s`ks``s`k`s`kk``s``s`ks``s`kk``sii`k``si`k`ki`k`k` +`si`k`ki``s`k`s`kk``s`k`s``s`ks``s`k`s`ks``s`k`s`k`s`k``s`k`s`k``si`kk``si`k +``si`k`ki``s`k`s`k`s``si`k`s``s`ksk``s`k`s`kk``s``s`ks``s`kk``s`ks```ss`si`k +k`k``si`kk``s`kk``s`kkk`kk`k`k`k`ki`k`k`k``s`k`s`k``s`k`s``si`k`kik``s``s`ks +``s`kk``sii`k``si`k`ki`k`k`k`k`k`ki`k``s`kkk`k``s`kk``s`k`s`kk``s``s`ks``s`k +`s`ks``s`k`s`k`s`ks``s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`` +s`ks``s`kk``s`ks``s`kk``s`k``si`kk``s``s``si`kk`k``si`k`ki`k```````s``siii`` +s``s`kski`s``s`ksk```sii``s``s`ksk``s``s`kski``s`k`s``si`k`kik``s``si`kk`k`` +`sii``s`k``s`k`s``si`k`kik``sii``s``s`ks``s`kk``s`ks``s`kk``s`ks``s`k`s`ks`` +s`k`s`kk``s`k`s`ks``s`k`s`kk``s``s`ks``s`kk``sii`k``si`k`ki`k``s`k`s`kk``s`` +s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk``s`k`s`k`s`ks``s`k`s`k`s`k`s`ks`` +s`k`s`k`s`k`s`k`s`ks``s`k`s`k`s`k`s`k`s`kk``s``s`ks``s`kk``s`ks``s`kk``s`ks` +`s`k`s`ks`s`kk`k``s`k`s`kk``s```sss`ks`k`k`k`ki`k`k`k``s`kk``s`kk``si`k`s``s +`ksk`kk`k`k`k`k``s`k``sii``s`k`s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s`k`s`k`s`kk +``s`k`s`k`s`k`s``s``s`ks``s`kk``s`ks``s`k`si```ss`si`kk`kk``s``s`ks``s`k`s`k +s``s`k`s`k`s`ks``s`k`s`k`s`kk``s``s`ks``s`k`s`ks``s`k`s`kk``s``s`ks``s`kk``s +ii`k``si`k`ki`k`k``si`k`ki`k`k`k``si`k`ki``s`kk``s`k`s``s`ks``s`k`s`ks``s`k` +s`k`s`k``s`k`s`k``si`kk``si`k``si`k`ki``s`k`s`k`s``si`k`s``s`ksk``s`k`s`kk`` +s``s`ks``s`kk``s``si`kk`k`s``s`ksk`k``si`kk``s`kk``s`kkk`k`k`k`k`````sii``s` +k`s``s`ks```ss`s``s`ks``s`kk``s`ks``s`k`sik`kk``s``s`ks``s`k`s`ks``s`k`s`k`s +``si`kk``s`k`s`kk``s``s`ks``s``s`ks``s`kk``sii`k``s`k`s``si`k`ki``s`kk``s`k` +s``s`ksk``si`k`ki`k`k`````s``s`kski``s``s`ksk``s``s`kski``s`k`s``si`k`kik`kk +``s``s`ks``s`k`s`ks``s`k`s`kk``s``s`ks``s`kk``sii`k``s``s`ks``s`k`si``s`kk`` +s`k`s``s`ksk``si`kk``s`kk``si`k`ki`k`k``si`k`ki``s``si`k`ki`k`ki`````s``s`ks +ki``s``s`ksk``s``s`kski``s`k`s``si`k`kik`kk``s`kk``s`k`s`k`s``s`ks``s`k`s``s +``s``s``si`k``s``s`ks``s`k`s`ks``s`k`s`k`s`ks``s``s`ks``s`k`s`ks``s`k`s`kk`` +s`k`s`ks``s``s`ks``s`kk``s`ksk`k``s`k`s``s`ks```ss`s``s`ks``s`kk``s`ks``s`k` +si``s`kk``s`k```s``s`ksk``s``s`kski````s``siii``s``s`kski`s``s`ksk``si`kk`kk +k`k`k``s`k`s``s``si`kk`k`ki``s`kk`s`k``si`k`ki`k`k`k``si`k`ki`k``s`k`s`kk``s +`k`s``s`kskk`ki`kik``s`k`s`kk``s`k`s`kk``s`k`s`k``s`k`s``si`k``s`k``s``s`ksk +i``s``s`ksk```sii``s``s`kskik``s``s`ks``s`kk``sii`k``si`k`ki```sii``s`k`s``s +``s``s``s``s``si`kk`k``s`k`sik``s`kk``s`k``si`kk``s`k```s``s`kski```s``s`ksk +```sii``s``s`kski``si`k`ki``s``s``si`kk`k``s`k`s``si`k`kik`k``s``si`kk`k```s +ii``s`k``s`k`s``si`k`kik``sii`k````s``s`kski````s``siii``s``s`kski``s`k`sik` +kk``s``s`ks``s`kk``s`ks``s`k`si```ss`si`kk`kk`ki``s``s`ks``s`kk``sii`k``si`k +`ki Added: trunk/languages/lazy-k/lazy.pir ============================================================================== --- (empty file) +++ trunk/languages/lazy-k/lazy.pir Mon Aug 1 15:32:52 2005 @@ -0,0 +1,488 @@ +# $Id$ + +=head1 DESCRIPTION + +This is a lazy-k interpreter - basically a rewrite of lazy.cpp in PIR. +Lazy-k is a pure functional programming language following the SKI calculus + +=head1 AUTHOR + +leo + +=head1 SEE ALSO + +L<http://en.wikipedia.org/wiki/Lazy_K_programming_language> + +=head1 TODO + + - (S(K ...)) syntax + - iota/Jot syntax + - chained commandline args and -e, -b + +And a lot of comments in the source - sorry. + +=cut + +.sub _main @MAIN + .param pmc argv + .local int argc + .local pmc in + argc = argv + if argc > 1 goto open_file + in = getstdin + goto run +open_file: + $S0 = argv[1] + in = open $S0, "<" + $I0 = defined in + if $I0 goto run + printerr "can't open '" + printerr $S0 + printerr "' for reading." + exit 1 +run: + .local pmc prog, e + $P0 = getinterp + create_globals() + e = global "I" + prog = parse(in) + ## _dumper( prog, "prog" ) + e = append(e, prog) + + .local pmc lr, NUL + null NUL + lr = new_expr('LR', NUL, NUL) + e = new_apply(e, lr) + ## deparse_e(e) + ## trace 15 +loop: + $P0 = car(e) + $I0 = church2int($P0) + if $I0 < 256 goto put + exit $I0 +put: + $S0 = chr $I0 + print $S0 + e = cdr(e) + goto loop +.end + +.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) +.end + +.sub append + .param pmc old + .param pmc n + .return compose(n, old) +.end + +.sub church2int + .param pmc church + + .local pmc e, Zero, Inc, result + Inc = global "Inc" + Zero = global "Zero" + e = new_apply(church, Inc) + e = new_apply(e, Zero) + result = eval(e) + $I0 = to_number(result) + if $I0 == -1 goto err + .return($I0) +err: + printerr "invalid output format - not a number\n" + exit 3 +.end + +.sub car + .param pmc list + .local pmc k + k = global "K" + .return new_apply(list, k) +.end + +.sub cdr + .param pmc list + .local pmc ki + ki = global "KI" + .return new_apply(list, ki) +.end + +.sub create_globals + .local pmc e, NUL, K, S, KS, I, KI + null NUL + K = new_expr('K', NUL, NUL) + global "K" = K + S = new_expr('S', NUL, NUL) + global "S" = S + I = new_expr('I', NUL, NUL) + global "I" = I + KI = new_expr('K1', I, NUL) + global "KI" = KI + e = new_expr('S1', I, NUL) + global "SI" = e + KS = new_expr('K1', S, NUL) + global "KS" = KS + e = new_expr('K1', K, NUL) + global "KK" = e + e = new_expr('S2', KS, K) + global "SKSK" = e + e = new_expr('S2', I, KS) + global "SIKS" = e + + e = new_expr('Inc', NUL, NUL) + global "Inc" = e + $P0 = new .Integer + e = new_expr('Num', $P0, NUL) + global "Zero" = e + + .local pmc cache + cache = new FixedPMCArray + cache = 257 + cache[0] = KI + cache[1] = I + global "church_cache" = cache + +.end + +.sub new_expr + .param string type + .param pmc lhs + .param pmc rhs + .local pmc expr + expr = new FixedPMCArray + expr = 3 + expr[0] = type + expr[1] = lhs + expr[2] = rhs + .return (expr) +.end + +.sub new_apply + .param pmc lhs + .param pmc rhs + .return new_expr('A', lhs, rhs) +.end + +.sub parse + .param pmc io + + .local string ch + .local pmc op, arg, NUL + .local pmc I, K, S + I = global "I" + K = global "K" + S = global "S" + null NUL +loop: + ch = read io, 1 + unless ch == '`' goto not_bq + op = parse(io) + arg = parse(io) + .return new_apply(op, arg) +not_bq: + unless ch == 'i' goto not_i + .return (I) +not_i: + unless ch == 'k' goto not_k + .return (K) +not_k: + unless ch == 's' goto not_s + .return (S) +not_s: +not_e: + unless ch == '#' goto not_comment + swallow: + ch = read io, 1 + if ch != "\n" goto swallow + goto loop +not_comment: + if ch == ' ' goto loop + if ch == "\t" goto loop + if ch == "\n" goto loop + if ch == "\r" goto loop + printerr "unrecogniced char in program '" + printerr ch + printerr "'\n" + exit 1 +.end + +.sub drop_i1 + .param pmc expr + .local pmc type + .local string ts +loop: + type = expr[0] + ts = type + if ts != 'I1' goto ret_e + expr = expr[1] + goto loop +ret_e: + .return (expr) +.end + +.sub int2church + .param int i + + .local pmc cached, e + cached = global "church_cache" + if i < 0 goto i256 + if i > 256 goto i256 + goto ok +i256: + i = 256 +ok: + e = cached[i] + unless_null e, ret + .local pmc sksk, e, cm1 + sksk = global "SKSK" + $I0 = i - 1 + cm1 = int2church($I0) + e = new_expr('S2', sksk, cm1) + cached[i] = e +ret: + .return (e) +.end + +.sub to_number + .param pmc expr + .local pmc type, arg1 + .local string ts + type = expr[0] + ts = type + if ts != 'Num' goto ret1 + $P0 = expr[1] + $I0 = $P0 + .return ($I0) +ret1: + .return (-1) +.end + +.sub apply + .param pmc expr + + .local pmc type, lhs, rhs, arg1, arg2, NUL + .local string ts + 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' + expr[1] = rhs + expr[2] = NUL + .return() +not_k: + unless ts == 'K1' goto not_k1 + expr[0] = 'I1' + $P0 = lhs[1] + expr[1] = $P0 + expr[2] = NUL + .return() +not_k1: + unless ts == 'I' goto not_i + expr[0] = 'I1' + expr[1] = rhs + expr[2] = NUL + .return() +not_i: + unless ts == 'S' goto not_s + expr[0] = 'S1' + expr[1] = rhs + expr[2] = NUL + .return() +not_s: + unless ts == 'S1' goto not_s1 + expr[0] = 'S2' + $P0 = lhs[1] + expr[1] = $P0 + expr[2] = rhs + .return() +not_s1: + unless ts == 'LR' goto not_lr + lhs[0] = 'S2' + .local pmc cc, k1c, s2ik1, i, io + .local string s + io = getstdin + $I0 = 256 + unless io goto eof + s = read io, 1 + if s == '' goto eof + $I0 = ord s + eof: + cc = int2church($I0) + i = global "I" + k1c = new_expr('K1', cc, NUL) + s2ik1 = new_expr('S2', i, k1c) + lhs[1] = s2ik1 + $P0 = new_expr('LR', NUL, NUL) + $P1 = new_expr('K1', $P0) + lhs[2] = $P1 + goto s2 +not_lr: + unless ts == 'S2' goto not_s2 +s2: + ## expr[0] = 'A' + $P0 = lhs[1] + $P1 = new_apply( $P0, rhs) + expr[1] = $P1 + $P0 = lhs[2] + $P2 = new_apply( $P0, rhs) + expr[2] = $P2 + .return() +not_s2: + unless ts == 'Inc' goto not_inc + rhs = eval(rhs) + $I0 = to_number(rhs) + inc $I0 + if $I0 goto num_ok + printerr "invalid Inc of non-number\n" + exit 1 +num_ok: + $P0 = new Integer + $P0 = $I0 + expr[0] = 'Num' + expr[1] = $P0 + expr[2] = NUL + .return() +not_inc: + unless ts == 'Num' goto not_num + printerr "invalid apply of number\n" + exit 1 +not_num: + printerr "unknown expression: '" + printerr ts + printerr "'\n" + exit 1 + .return() +.end + +.sub deparse + .param pmc expr + .local pmc type, arg1, arg2 + .local string ts + type = expr[0] + ts = type + unless ts == 'A' goto not_a + print "(" + arg1 = expr[1] + deparse(arg1) + print " " + arg2 = expr[2] + deparse(arg2) + print ")" + .return() +not_a: + unless ts == 'K' goto not_k + print "K" + .return() +not_k: + unless ts == 'I' goto not_i + print "I" + .return() +not_i: + unless ts == 'K1' goto not_k1 + print "[K" + arg1 = expr[1] + deparse(arg1) + print "]" + .return() +not_k1: + unless ts == 'I1' goto not_i1 + print "[I" + arg1 = expr[1] + deparse(arg1) + print "]" + .return() +not_i1: + unless ts == 'S' goto not_s + print "S" + .return() +not_s: + unless ts == 'S1' goto not_s1 + print "[S" + arg1 = expr[1] + deparse(arg1) + print "]" + .return() + +not_s1: + unless ts == 'S2' goto not_s2 + print "[s" + arg1 = expr[1] + deparse(arg1) + print " " + arg2 = expr[2] + deparse(arg2) + print "]" + .return() +not_s2: + unless ts == 'LR' goto not_lr + print "R" + .return() +not_lr: + unless ts == 'Inc' goto not_inc + print "I" + .return() +not_inc: + unless ts == 'Num' goto not_num + $I0 = expr[1] + print $I0 + .return() +not_num: + printerr "unknown expression: '" + printerr ts + printerr "'\n" + exit 1 + .return() +.end + +.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: Added: trunk/languages/lazy-k/powers2.lazy ============================================================================== --- (empty file) +++ trunk/languages/lazy-k/powers2.lazy Mon Aug 1 15:32:52 2005 @@ -0,0 +1,5 @@ +# print an infinte number of stars representing powers of 2 + +`k````sii``s`k`si``s`k`s`k``s`k`s``si`k``s`k``s``s`kski``s``s`ksk```s +ii``s``s`kskik``s``s`ks``s`kk``sii`k``s``s`kski``s`k`s``si`k``s`k``s` +`s`kski````s``s`ksk```sii``s``s`kski`s``s`ksk```s``siii``s``s`kskik Added: trunk/languages/lazy-k/test.sh ============================================================================== --- (empty file) +++ trunk/languages/lazy-k/test.sh Mon Aug 1 15:32:52 2005 @@ -0,0 +1 @@ +echo '1+2*3' | ../../parrot lazy.pir calc.lazy
