def transition_MUL(self):
a = int(mem.g_symtable[-mem.g_mem[self.S]['car']])
self.S = mem.g_mem[self.S]['cdr']
b = int(mem.g_symtable[-mem.g_mem[self.S]['car']])
self.S = mem.g_mem[self.S]['cdr']
sym = '%d' % (a * b)
self.S = mem.secd_mem_cons(-mem.secd_sym_get_create(sym), self.S)
def cycle(self, verbose=False, startncycle=0):
self.stack_depth = 0
self.ncycles = startncycle
try:
if verbose:
print "[%d]" % self.ncycles
print self.state()
pc = mem.g_mem[self.C]['car']
while pc < 0 and 0 != (pc + mem.secd_sym_get_create('STOP')):
# if 0 == (self.ncycles % 1000):
# print "[%6d]" % self.ncycles, mem.secd_mem_load()
if None != self.logmem:
m_load = mem.secd_mem_load()
self.logmem.write(
'%6d, %2.4f, %5d, %5d\n' %
(self.ncycles, m_load * 100. / mem.g_MEMSIZE, m_load,
mem.secd_mem_len(self.S)))
# idtop = mem.secd_mem_newcell()
# if idtop > ((mem.g_MEMSIZE * 50) // 100):
# mem.secd_mem_gc(self)
self.ncycles += 1
self.mnemonics[mem.g_symtable[-pc]]()
self.C = mem.g_mem[self.C]['cdr']
pc = mem.g_mem[self.C]['car']
if verbose:
print "[%d]" % self.ncycles
print self.state()
except mem.SECDMemFullError as err:
print "SECDMemFullError", err.message
print self.state()
def transition_DIV(self):
a = int(mem.g_symtable[-mem.g_mem[self.S]['car']])
self.S = mem.g_mem[self.S]['cdr']
b = int(mem.g_symtable[-mem.g_mem[self.S]['car']])
self.S = mem.g_mem[self.S]['cdr']
sym = '%d' % (b // a) # Floor division on integers
self.S = mem.secd_mem_cons(-mem.secd_sym_get_create(sym), self.S)
def transition_AP(self):
def slurp(idx):
if mem.KW_SKP == mem.g_mem[idx]['car']:
return mem.NIL
else:
return mem.secd_mem_cons(mem.g_mem[idx]['car'],
slurp(mem.g_mem[idx]['cdr']))
idenv = self.E
idargsv = mem.g_mem[self.S]['cdr']
idargs = mem.g_mem[mem.g_mem[mem.g_mem[self.S]['car']]['car']]['car']
idnext = mem.g_mem[mem.g_mem[mem.g_mem[self.S]['car']]['car']]['cdr']
self.E = mem.g_mem[mem.g_mem[self.S]['car']]['cdr']
while mem.NIL != idargs:
if mem.KW_REST == mem.g_mem[idargs]['car']:
idargs = mem.g_mem[idargs]['cdr']
idslurp = slurp(idargsv)
self.E = alist.secd_alist_push(mem.g_mem[idargs]['car'],
idslurp, self.E)
idargs = mem.g_mem[idargs]['cdr']
else:
self.E = alist.secd_alist_push(mem.g_mem[idargs]['car'],
mem.g_mem[idargsv]['car'],
self.E)
idargs = mem.g_mem[idargs]['cdr']
idargsv = mem.g_mem[idargsv]['cdr']
self.D = mem.secd_mem_cons(
idargsv,
mem.secd_mem_cons(
idenv, mem.secd_mem_cons(mem.g_mem[self.C]['cdr'], self.D)))
# self.S = mem.NIL
# This caused a problem when first sexp pushed to stack is nil, as nil == (nil) == 0 in g_mem
# We start with a sentinel on the stack, which will be removed by RTN (which keeps only the top)
self.stack_depth += 1
# self.S = mem.secd_mem_setcdr(
# mem.secd_mem_setcar(
# mem.secd_mem_newcell(),-mem.secd_sym_get_create('*STACK-%d*' % self.stack_depth)), mem.NIL)
self.S = mem.secd_mem_setcdr(
mem.secd_mem_setcar(mem.secd_mem_newcell(),
-mem.secd_sym_get_create('*FILLER*')), mem.NIL)
self.C = mem.secd_mem_cons(mem.NOP, idnext)
# '(DUM LDF ((elist) LD nil LD elist EQ SEL (LD nil JOIN) (LD elist CAR CAR LD elist CDR LD secdcompvars AP CONS JOIN) RTN) LDF ((elist n c) LD nil LD elist EQ SEL (LD c JOIN) (LD c LD n LD elist CAR CDR CAR LD secdcomp AP LD n LD elist CDR LD secdcomplist AP JOIN) RTN) LDF ((e n c) LD e ATOM SEL (LDC LD LD e LD c CONS CONS JOIN) (LDC car LD e CAR EQ SEL (LDC CAR LD c CONS LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC cdr LD e CAR EQ SEL (LDC CDR LD c CONS LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC atom LD e CAR EQ SEL (LDC ATOM LD c CONS LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC quote LD e CAR EQ SEL (LDC LDC LD e CDR CAR LD c CONS CONS JOIN) (LDC cons LD e CAR EQ SEL (LDC CONS LD c CONS LD n LD e CDR CDR CAR LD secdcomp AP LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC eq LD e CAR EQ SEL (LDC EQ LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC leq LD e CAR EQ SEL (LDC LEQ LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC add LD e CAR EQ SEL (LDC ADD LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC sub LD e CAR EQ SEL (LDC SUB LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC mul LD e CAR EQ SEL (LDC MUL LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC div LD e CAR EQ SEL (LDC DIV LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC rem LD e CAR EQ SEL (LDC REM LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC if LD e CAR EQ SEL (LDC (JOIN) LD n LD e CDR CDR CDR CAR LD secdcomp AP LDC (JOIN) LD n LD e CDR CDR CAR LD secdcomp AP LDF ((cont-t cont-f) LDC SEL LD cont-t LD cont-f LD c CONS CONS CONS LD n LD e CDR CAR LD secdcomp AP RTN) AP JOIN) (LDC lambda LD e CAR EQ SEL (LDC LDF LD e CDR CAR LDC (RTN) LD n LD e CDR CDR CAR LD secdcomp AP CONS LD c CONS CONS JOIN) (LDC let LD e CAR EQ SEL (LDC DUM LDC LDF LD e CDR CAR LD secdcompvars AP LDC (RTN) LD n LD e CDR CDR CAR LD secdcomp AP CONS LDC RAP LD c CONS CONS CONS LD n LD e CDR CAR LD secdcomplist AP CONS JOIN) (LDC AP LD c CONS LD n LD e CAR LD secdcomp AP LD n LD e CDR LD secd-comp--args AP JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) RTN) LDF ((secdcomp secdcomplist secdcompvars) LDC (STOP) LD nil LDC LD secdcomp AP RTN) RAP STOP)'
# '(LDC (add (quote 3) (mul (quote 2) (quote 3))) STOP)'
# '(DUM LDF ((n) LDC 1 LD n EQ SEL (LDC 1 JOIN) (LD n LDC 1 SUB LD fac AP LD n MUL JOIN) RTN) LDF ((fac) LDC 3 LD fac AP RTN) RAP STOP)'
# '(DUM LDF ((elist n c) LD elist LD nil EQ SEL (LD c JOIN) (LD c LD n LD elist CAR LD secdcomp AP LD n LD elist CDR LD secdcompargs AP JOIN) RTN) LDF ((elist) LD elist LD nil EQ SEL (LD nil JOIN) (LD elist CAR CAR LD elist CDR LD secdcompvars AP CONS JOIN) RTN) LDF ((elist n c) LD elist LD nil EQ SEL (LD c JOIN) (LD c LD n LD elist CAR CDR CAR LD secdcomp AP LD n LD elist CDR LD secdcomplist AP JOIN) RTN) LDF ((e n c) LD e ATOM SEL (LDC LD LD e LD c CONS CONS JOIN) (LDC car LD e CAR EQ SEL (LDC CAR LD c CONS LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC cdr LD e CAR EQ SEL (LDC CDR LD c CONS LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC atom LD e CAR EQ SEL (LDC ATOM LD c CONS LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC quote LD e CAR EQ SEL (LDC LDC LD e CDR CAR LD c CONS CONS JOIN) (LDC cons LD e CAR EQ SEL (LDC CONS LD c CONS LD n LD e CDR CDR CAR LD secdcomp AP LD n LD e CDR CAR LD secdcomp AP JOIN) (LDC eq LD e CAR EQ SEL (LDC EQ LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC leq LD e CAR EQ SEL (LDC LEQ LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC add LD e CAR EQ SEL (LDC ADD LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC sub LD e CAR EQ SEL (LDC SUB LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC mul LD e CAR EQ SEL (LDC MUL LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC div LD e CAR EQ SEL (LDC DIV LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC rem LD e CAR EQ SEL (LDC REM LD c CONS LD n LD e CDR CAR LD secdcomp AP LD n LD e CDR CDR CAR LD secdcomp AP JOIN) (LDC if LD e CAR EQ SEL (LDC (JOIN) LD n LD e CDR CDR CDR CAR LD secdcomp AP LDC (JOIN) LD n LD e CDR CDR CAR LD secdcomp AP LDF ((contt contf) LDC SEL LD contt LD contf LD c CONS CONS CONS LD n LD e CDR CAR LD secdcomp AP RTN) AP JOIN) (LDC lambda LD e CAR EQ SEL (LDC LDF LD e CDR CAR LDC (RTN) LD n LD e CDR CDR CAR LD secdcomp AP CONS LD c CONS CONS JOIN) (LDC let LD e CAR EQ SEL (LDC DUM LDC LDF LD e CDR CAR LD secdcompvars AP LDC (RTN) LD n LD e CDR CDR CAR LD secdcomp AP CONS LDC RAP LD c CONS CONS CONS LD n LD e CDR CAR LD secdcomplist AP CONS JOIN) (LDC AP LD c CONS LD n LD e CAR LD secdcomp AP LD n LD e CDR LD secdcompargs AP JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) JOIN) RTN) LDF ((secdcomp secdcomplist secdcompvars secdcompargs) LD nil LD nil LDC (let ((inc (lambda (x) (add x (quote 1))))) (inc (quote 3))) LD secdcomp AP RTN) RAP STOP)'
# '(DUM LDF ((x) LDC 1 LD x ADD RTN) LDF ((inc) LDC 3 LD inc AP RTN) RAP STOP)'
# '(DUM LDF ((n) LDC 1 LD n EQ SEL (LDC 1 JOIN) (LD n LDC 1 SUB LD fac AP LD n MUL JOIN) RTN) LDF ((fac) LDC 11 LD fac AP RTN) RAP)'
# '(DUM LDC 2 LDC 1 LDF ((X Y) LD Y LD X ADD RTN) RAP)'
# '(DUM LDF ((arg) LD arg LD nil EQ SEL (LDC False JOIN) (LDC 1 LD arg CAR LDC True EQ SEL (LDC True JOIN) (LD arg CDR LD or AP JOIN) JOIN) RTN) LDF ((or) LDC (True True) LD or AP RTN) RAP)'
# '(LDC 1 LD nil CONS STOP)'
# '(DUM LDF ((x y &rest z) LD y LD x ADD LD z CONS RTN) LDF ((foo) SKP LDC FOO LDC 3 LDC 2 LD foo AP RTN) RAP)'
# '(LDC S)'
'(DUM LDF ((x y) LD x LD y LDE (SKP LD y LD x ADD LD y ADD LD y LD x ADD LD fib AP UPD) CONS CONS RTN) LDF ((fib) SKP LDC 1 LDC 1 LD fib AP CDR CDR AP0 CDR CDR AP0 CAR RTN) RAP STOP)'
)
secd.E = alist.secd_alist_push(-mem.secd_sym_get_create('SOURCE'),
-mem.secd_sym_get_create('SOURCE'), secd.E)
# Run
print secd.state()
secd.cycle(verbose=True)
print secd.state()
print '%d cycles.' % secd.ncycles
print "Load: %3.2f %%" % (100.0 * mem.secd_mem_load() / mem.g_MEMSIZE)
print "Garbage collector (%d cells)" % len(mem.secd_mem_gc(secd))
print "Load: %3.2f %%\n" % (100.0 * mem.secd_mem_load() / mem.g_MEMSIZE)
print mem.g_symtable
# assl = mem.NIL
# assl = alist.secd_alist_push( -mem.secd_sym_get_create( 'KEY'), -mem.secd_sym_get_create( 'VALUE' ), assl)
# print parse.secd_mem2sexp( assl )
parser = argparse.ArgumentParser(description='funx Metacircular Strict Compiler.\n(c) jmc 2021.')
parser.add_argument('--log', type=argparse.FileType('w'), help='logfile (optional)')
parser.add_argument('--verbose', default=False, action='store_true')
parser.add_argument('--alternate', default='compiler.secd', help='alternate compiler secd-file')
parser.add_argument('infile', type=argparse.FileType('r'), help='funx source file')
parser.add_argument('outfile', nargs='?', type=argparse.FileType('w'),
default = sys.stdout, help='secd compiled file')
args = parser.parse_args()
with open(args.alternate, 'r') as f:
fmcc_template = f.read()
funx_source = args.infile.read()
fmcc = fmcc_template % funx_source
# Init
secd = am.SECDAbstractMachine(logfile='secdcomp.log')
secd.C = parse.secd_sexp2mem( fmcc )
secd.E = alist.secd_alist_push(-mem.secd_sym_get_create('*FMCC*'), -mem.secd_sym_get_create('1.0'), secd.E)
secd.cycle( verbose=args.verbose )
args.outfile.write( parse.secd_mem2sexp(mem.g_mem[secd.S]['car']) )
if None != args.log:
args.log.write( '%d cycles.\n' % secd.ncycles )
args.log.write("Load: %3.2f %%\n" % (100.0*mem.secd_mem_load()/mem.g_MEMSIZE))
args.log.write("Garbage collector (%d cells)\n" % len(mem.secd_mem_gc( secd )))
args.log.write("Load: %3.2f %%\n" % (100.0 * mem.secd_mem_load() / mem.g_MEMSIZE))
args.log.close()
args.infile.close()
args.outfile.close()
parser.add_argument('infile',
nargs='?',
type=argparse.FileType('r'),
default=sys.stdin,
help='SECD source file')
parser.add_argument('--outfile',
type=argparse.FileType('w'),
default=sys.stdout,
help='result of execution (optional)')
args = parser.parse_args()
secd_source = args.infile.read()
# Init
secd = am.SECDAbstractMachine()
secd.C = parse.secd_sexp2mem(secd_source)
if None != args.env:
secd.E = parse.secd_sexp2mem(args.env)
secd.E = alist.secd_alist_push(-mem.secd_sym_get_create('*SECDAM*'),
-mem.secd_sym_get_create('1.0'), secd.E)
secd.cycle(verbose=(args.verbose))
args.outfile.write(parse.secd_mem2sexp(secd.S))
if None != args.log:
args.log.write('%d cycles.\n' % secd.ncycles)
args.log.write("Load: %3.2f %%\n" %
(100.0 * mem.secd_mem_load() / mem.g_MEMSIZE))
args.log.write("Garbage collector (%d cells)\n" %
len(mem.secd_mem_gc(secd)))
args.log.write("Load: %3.2f %%\n" %
(100.0 * mem.secd_mem_load() / mem.g_MEMSIZE))
args.log.close()
