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
