[svn:parrot] r35970 - trunk/languages/unlambda
[email protected] Sat, 24 Jan 2009 14:10:29 -0800 (PST)
| Newsgroups | perl.cvs.parrot |
|---|---|
| Message-ID | <[email protected]> |
Author: bernhard
Date: Sat Jan 24 14:10:29 2009
New Revision: 35970
Modified:
trunk/languages/unlambda/unl.pir
Log:
[unlambda] PIR formatting
Modified: trunk/languages/unlambda/unl.pir
==============================================================================
--- trunk/languages/unlambda/unl.pir (original)
+++ trunk/languages/unlambda/unl.pir Sat Jan 24 14:10:29 2009
@@ -15,18 +15,20 @@
=head1 SEE ALSO
L<http://www.madore.org/~david/programs/unlambda/>
+L<http://en.wikipedia.org/wiki/Unlambda>
=cut
.sub _main :main
.param pmc argv
+
.local int argc
.local pmc in, cchar
argc = argv
if argc > 1 goto open_file
in = getstdin
goto run
-open_file:
+ open_file:
$S0 = argv[1]
in = open $S0, 'r'
$I0 = defined in
@@ -35,7 +37,7 @@
printerr $S0
printerr "' for reading."
exit 1
-run:
+ run:
.local pmc prog
$P0 = getinterp
$P0."recursion_limit"(50000)
@@ -63,7 +65,7 @@
.const 'Sub' e = "e"
.const 'Sub' rd = "rd"
.const 'Sub' pc = "pc"
-loop:
+ loop:
ch = read io, 1
unless ch == '`' goto not_bq
op = parse(io)
@@ -73,57 +75,57 @@
pair[0] = op
pair[1] = arg
.return (pair)
-not_bq:
+ not_bq:
unless ch == '.' goto not_dot
$S0 = read io, 1
arg = new 'String'
arg = $S0
.tailcall clos_pr(arg)
-not_dot:
+ not_dot:
unless ch == '@' goto not_rd
.return (rd)
-not_rd:
+ not_rd:
unless ch == '|' goto not_pc
.return (pc)
-not_pc:
+ not_pc:
unless ch == '?' goto not_rc
$S0 = read io, 1
arg = new 'String'
arg = $S0
.tailcall clos_rc(arg)
-not_rc:
+ not_rc:
unless ch == 'r' goto not_r
arg = new 'String'
arg = "\n"
.tailcall clos_pr(arg)
-not_r:
+ not_r:
unless ch == 'i' goto not_i
.return (i)
-not_i:
+ not_i:
unless ch == 'k' goto not_k
.return (k)
-not_k:
+ not_k:
unless ch == 's' goto not_s
.return (s)
-not_s:
+ not_s:
unless ch == 'v' goto not_v
.return (v)
-not_v:
+ not_v:
unless ch == 'c' goto not_c
.return (c)
-not_c:
+ not_c:
unless ch == 'd' goto not_d
.return (d)
-not_d:
+ not_d:
unless ch == 'e' goto not_e
.return (e)
-not_e:
+ not_e:
unless ch == '#' goto not_comment
- swallow:
+ swallow:
ch = read io, 1
if ch != "\n" goto swallow
goto loop
-not_comment:
+ not_comment:
if ch == ' ' goto loop
if ch == "\t" goto loop
if ch == "\n" goto loop
@@ -137,6 +139,7 @@
# debugging helper
.sub unparse
.param pmc exp
+
$I0 = isa exp, 'FixedPMCArray'
unless $I0 goto no_ar
$I1 = elements exp
@@ -148,7 +151,7 @@
unparse(car)
unparse(cdr)
.return()
-no_ar:
+ no_ar:
$S0 = exp
print $S0
.end
@@ -156,6 +159,7 @@
# debugging helper
.sub unparse_all
.param pmc exp
+
unparse(exp)
print "\n"
.end
@@ -165,6 +169,7 @@
#
.sub ev
.param pmc exp
+
## unparse_all(exp)
$I0 = isa exp, 'FixedPMCArray'
unless $I0 goto no_ar
@@ -181,12 +186,12 @@
if car != d goto not_d
.tailcall clos_d1(cdr)
- not_d:
+ not_d:
arg = ev(cdr)
.tailcall op(arg)
-no_ar:
+ no_ar:
.return (exp)
-no_pair:
+ no_pair:
printerr "no pair\n"
exit 1
.end
@@ -197,6 +202,7 @@
.sub clos_pr
.param pmc arg
+
.local pmc cl
.lex 'x', arg
.const 'Sub' pr = "pr"
@@ -208,6 +214,7 @@
# r print newline
.sub pr :outer(clos_pr)
.param pmc arg
+
.local pmc x
x = find_lex "x"
print x
@@ -217,18 +224,21 @@
# i identy
.sub i
.param pmc arg
+
.return (arg)
.end
# k constant generator
.sub k
.param pmc arg
+
.const 'Sub' k1 = "k1"
.tailcall clos_k1(arg)
.end
.sub clos_k1
.param pmc arg
+
.local pmc cl
.lex 'x', arg
.const 'Sub' k1 = "k1"
@@ -239,6 +249,7 @@
# `kX contant function
.sub k1 :outer(clos_k1)
.param pmc arg
+
.local pmc x
x = find_lex "x"
.return (x)
@@ -247,11 +258,13 @@
# s substitution
.sub s
.param pmc arg
+
.tailcall clos_s1("x", arg)
.end
.sub clos_s1
.param pmc arg
+
.local pmc cl
.lex 'x', arg
.const 'Sub' s1 = "s1"
@@ -262,6 +275,7 @@
# `sX substitution first partial
.sub s1 :outer(clos_s1)
.param pmc arg
+
.local pmc x
x = find_lex 'x'
.tailcall clos_s2(x, arg)
@@ -273,6 +287,7 @@
.sub clos_s2
.param pmc arg
.param pmc arg2
+
.local pmc cl
.lex 'x', arg
.lex 'y', arg2
@@ -284,6 +299,7 @@
# ``sXY substitution application
.sub s2 :outer(clos_s2)
.param pmc z
+
.local pmc x, y, f1, f2
x = find_lex 'x'
y = find_lex 'y'
@@ -298,6 +314,7 @@
.sub v
.param pmc arg
.param pmc self
+
self = interpinfo .INTERPINFO_CURRENT_SUB
.return (self)
.end
@@ -305,6 +322,7 @@
# c call/cc
.sub c
.param pmc x
+
.local pmc cc, c1
cc = interpinfo .INTERPINFO_CURRENT_CONT
.const 'Sub' c1 = "c1"
@@ -314,6 +332,7 @@
.sub clos_c1
.param pmc arg
+
.local pmc cl
.lex 'cc', arg
.const 'Sub' c1 = "c1"
@@ -324,6 +343,7 @@
# <cont>
.sub c1 :outer(clos_c1)
.param pmc x
+
.local pmc cc
cc = find_lex 'cc'
cc(x)
@@ -339,6 +359,7 @@
.sub clos_d1
.param pmc arg
+
.local pmc cl
.lex 'F', arg
.const 'Sub' d1 = "d1"
@@ -349,6 +370,7 @@
# `dF promise
.sub d1 :outer(clos_d1)
.param pmc y
+
.local pmc x, f
f = find_lex 'F'
x = ev(f)
@@ -358,6 +380,7 @@
# e exit
.sub e
.param pmc x
+
$I0 = x
exit $I0
.end
@@ -365,6 +388,7 @@
# @ read
.sub rd
.param pmc x
+
.local pmc cchar, i, v, io
.local string ch
io = getstdin
@@ -376,13 +400,14 @@
if ch == '' goto void
.const 'Sub' i = "i"
.tailcall x(i)
-void:
+ void:
.const 'Sub' v = "v"
.tailcall x(v)
.end
.sub clos_rc
.param pmc arg
+
.local pmc cl
.lex 'ch', arg
.const 'Sub' rc = "rc"
@@ -393,6 +418,7 @@
# ?x compare character read
.sub rc :outer(clos_rc)
.param pmc x
+
.local pmc cchar, i, v
.local string ch
cchar = get_global "cchar"
@@ -403,7 +429,7 @@
$S0 = $P0
if $S0 != ch goto void
.tailcall x(i)
-void:
+ void:
.const 'Sub' v = "v"
.tailcall x(v)
.end
@@ -411,6 +437,7 @@
# | reprint character read
.sub pc
.param pmc x
+
.local pmc cchar, i, v, pr, p, s
.local string ch
cchar = get_global "cchar"
@@ -419,7 +446,7 @@
s = clone cchar
p = clos_pr(s)
.tailcall x(p)
-void:
+ void:
.const 'Sub' v = "v"
.tailcall x(v)
.end