Author: fperrad
Date: Thu Dec 11 01:28:05 2008
New Revision: 33795
Modified:
trunk/languages/unlambda/unl.pir
Log:
[unlambda] global
- update with get/set_global
Modified: trunk/languages/unlambda/unl.pir
==============================================================================
--- trunk/languages/unlambda/unl.pir (original)
+++ trunk/languages/unlambda/unl.pir Thu Dec 11 01:28:05 2008
@@ -41,7 +41,7 @@
$P0."recursion_limit"(50000)
prog = parse(in)
cchar = new 'String'
- global "cchar" = cchar
+ set_global "cchar", cchar
# _dumper( prog, "prog" )
ev(prog)
.end
@@ -66,63 +66,63 @@
loop:
ch = read io, 1
unless ch == '`' goto not_bq
- op = parse(io)
- arg = parse(io)
- pair = new 'FixedPMCArray'
- pair = 2
- pair[0] = op
- pair[1] = arg
- .return (pair)
+ op = parse(io)
+ arg = parse(io)
+ pair = new 'FixedPMCArray'
+ pair = 2
+ pair[0] = op
+ pair[1] = arg
+ .return (pair)
not_bq:
unless ch == '.' goto not_dot
- $S0 = read io, 1
- arg = new 'String'
- arg = $S0
- .tailcall clos_pr(arg)
+ $S0 = read io, 1
+ arg = new 'String'
+ arg = $S0
+ .tailcall clos_pr(arg)
not_dot:
unless ch == '@' goto not_rd
- .return (rd)
+ .return (rd)
not_rd:
unless ch == '|' goto not_pc
- .return (pc)
+ .return (pc)
not_pc:
unless ch == '?' goto not_rc
- $S0 = read io, 1
- arg = new 'String'
- arg = $S0
- .tailcall clos_rc(arg)
+ $S0 = read io, 1
+ arg = new 'String'
+ arg = $S0
+ .tailcall clos_rc(arg)
not_rc:
unless ch == 'r' goto not_r
- arg = new 'String'
- arg = "\n"
- .tailcall clos_pr(arg)
+ arg = new 'String'
+ arg = "\n"
+ .tailcall clos_pr(arg)
not_r:
unless ch == 'i' goto not_i
- .return (i)
+ .return (i)
not_i:
unless ch == 'k' goto not_k
- .return (k)
+ .return (k)
not_k:
unless ch == 's' goto not_s
- .return (s)
+ .return (s)
not_s:
unless ch == 'v' goto not_v
- .return (v)
+ .return (v)
not_v:
unless ch == 'c' goto not_c
- .return (c)
+ .return (c)
not_c:
unless ch == 'd' goto not_d
- .return (d)
+ .return (d)
not_d:
unless ch == 'e' goto not_e
- .return (e)
+ .return (e)
not_e:
unless ch == '#' goto not_comment
swallow:
- ch = read io, 1
- if ch != "\n" goto swallow
- goto loop
+ ch = read io, 1
+ if ch != "\n" goto swallow
+ goto loop
not_comment:
if ch == ' ' goto loop
if ch == "\t" goto loop
@@ -139,15 +139,15 @@
.param pmc exp
$I0 = isa exp, 'FixedPMCArray'
unless $I0 goto no_ar
- $I1 = elements exp
- if $I1 != 2 goto no_ar
- .local pmc car, cdr
- print "`"
- car = exp[0]
- cdr = exp[1]
- unparse(car)
- unparse(cdr)
- .return()
+ $I1 = elements exp
+ if $I1 != 2 goto no_ar
+ .local pmc car, cdr
+ print "`"
+ car = exp[0]
+ cdr = exp[1]
+ unparse(car)
+ unparse(cdr)
+ .return()
no_ar:
$S0 = exp
print $S0
@@ -168,22 +168,22 @@
## unparse_all(exp)
$I0 = isa exp, 'FixedPMCArray'
unless $I0 goto no_ar
- $I1 = elements exp
- if $I1 != 2 goto no_pair
- .local pmc car, cdr, op, arg
- .const 'Sub' d = "d"
- car = exp[0]
- cdr = exp[1]
- # this is tricky - we have to apply car
- # but discard it if it's delayed
- # else this doesn't play together with call/cc
- op = ev(car)
- if car != d goto not_d
- .tailcall clos_d1(cdr)
+ $I1 = elements exp
+ if $I1 != 2 goto no_pair
+ .local pmc car, cdr, op, arg
+ .const 'Sub' d = "d"
+ car = exp[0]
+ cdr = exp[1]
+ # this is tricky - we have to apply car
+ # but discard it if it's delayed
+ # else this doesn't play together with call/cc
+ op = ev(car)
+ if car != d goto not_d
+ .tailcall clos_d1(cdr)
not_d:
- arg = ev(cdr)
- .tailcall op(arg)
+ arg = ev(cdr)
+ .tailcall op(arg)
no_ar:
.return (exp)
no_pair:
@@ -371,7 +371,7 @@
ch = ''
unless io goto void
ch = read io, 1
- cchar = global "cchar"
+ cchar = get_global "cchar"
cchar = ch
if ch == '' goto void
.const 'Sub' i = "i"
@@ -395,7 +395,7 @@
.param pmc x
.local pmc cchar, i, v
.local string ch
- cchar = global "cchar"
+ cchar = get_global "cchar"
ch = cchar
if ch == '' goto void
.const 'Sub' i = "i"
@@ -413,10 +413,10 @@
.param pmc x
.local pmc cchar, i, v, pr, p, s
.local string ch
- cchar = global "cchar"
+ cchar = get_global "cchar"
ch = cchar
if ch == '' goto void
- s = clone cchar
+ s = clone cchar
p = clos_pr(s)
.tailcall x(p)
void:
