def is_tagged_list(component, the_tag):
    return is_pair(component) and head(component) == the_tag
def reg(name):
    return llist("reg", name)

def is_register_exp(exp):
    return is_tagged_list(exp, "reg")

def register_exp_reg(exp):
    return head(tail(exp))
def constant(value):
    return llist("constant", value)

def is_constant_exp(exp):
    return is_tagged_list(exp, "constant")

def constant_exp_value(exp):
    return head(tail(exp))
def label(name):
    return llist("label", name)

def is_label_exp(exp):
    return is_tagged_list(exp, "label")

def label_exp_label(exp):
    return head(tail(exp))
def get_register(machine, reg_name):
    return machine("get_register")(reg_name)
def type(instruction):
    return head(instruction)
def lookup_prim(symbol, operations):
    val = assoc(symbol, operations)
    return (error("unknown operation -- assemble", symbol) if is_undefined(val)
            else head(tail(val)))
def lookup_label(labels, label_name):
    val = assoc(label_name, labels)
    return (error("undefined label -- assemble", label_name) if is_undefined(val)
            else tail(val))
def make_primitive_exp_ef(exp, machine, labels):
    if is_constant_exp(exp):
        c = constant_exp_value(exp)
        return lambda: c
    elif is_label_exp(exp):
        insts = lookup_label(labels, label_exp_label(exp))
        return lambda: insts
    elif is_register_exp(exp):
        r = get_register(machine, register_exp_reg(exp))
        return lambda: get_contents(r)
    else:
        error("unknown expression type -- assemble", exp)
def make_operation_exp_ef(exp, machine, labels, operations):
    op = lookup_prim(operation_exp_op(exp), operations)
    afuns = map(lambda e: make_primitive_exp_ef(e, machine, labels),
                operation_exp_operands(exp))
    return lambda: apply_in_underlying_python(op, map(lambda f: f(), afuns))
def assign(register_name, source):
    return llist("assign", register_name, source)
def assign_reg_name(assign_instruction):
    return head(tail(assign_instruction))
def assign_value_exp(assign_instruction):
    return head(tail(tail(assign_instruction)))
def make_assign_ef(inst, machine, labels, operations, pc):
    target = get_register(machine, assign_reg_name(inst))
    value_exp = assign_value_exp(inst)
    value_fun = (make_operation_exp_ef(value_exp, machine, labels, operations)
                 if is_operation_exp(value_exp)
                 else make_primitive_exp_ef(value_exp, machine, labels))
    def execution_fun():
        set_contents(target, value_fun())
        advance_pc(pc)
    return execution_fun
def advance_pc(pc):
    set_contents(pc, tail(get_contents(pc)))
def make_test_ef(inst, machine, labels, operations, flag, pc):
    condition = test_condition(inst)
    if is_operation_exp(condition):
        condition_fun = make_operation_exp_ef(condition, machine, labels, operations)
        def execution_fun():
            set_contents(flag, condition_fun())
            advance_pc(pc)
        return execution_fun
    else:
        error("bad test instruction -- assemble", inst)
def test(condition):
    return llist("test", condition)

def test_condition(test_instruction):
    return head(tail(test_instruction))
def make_branch_ef(inst, machine, labels, flag, pc):
    dest = branch_dest(inst)
    if is_label_exp(dest):
        insts = lookup_label(labels, label_exp_label(dest))
        def execution_fun():
            if get_contents(flag):
                set_contents(pc, insts)
            else:
                advance_pc(pc)
        return execution_fun
    else:
        error("bad branch instruction -- assemble", inst)
def branch(label):
    return llist("branch", label)

def branch_dest(branch_instruction):
    return head(tail(branch_instruction))
def make_go_to_ef(inst, machine, labels, pc):
    dest = go_to_dest(inst)
    if is_label_exp(dest):
        insts = lookup_label(labels, label_exp_label(dest))
        return lambda: set_contents(pc, insts)
    elif is_register_exp(dest):
        reg = get_register(machine, register_exp_reg(dest))
        return lambda: set_contents(pc, get_contents(reg))
    else:
        error("bad go_to instruction -- assemble", inst)
def go_to(label):
    return llist("go_to", label)

def go_to_dest(go_to_instruction):
    return head(tail(go_to_instruction))
def pop(stack):
    return stack("pop")
def push(stack, value):
    return stack("push")(value)
def make_save_ef(inst, machine, stack, pc):
    reg = get_register(machine, stack_inst_reg_name(inst))
    def execution_fun():
        push(stack, get_contents(reg))
        advance_pc(pc)
    return execution_fun
def make_restore_ef(inst, machine, stack, pc):
    reg = get_register(machine, stack_inst_reg_name(inst))
    def execution_fun():
        set_contents(reg, pop(stack))
        advance_pc(pc)
    return execution_fun
def save(reg):
    return llist("save", reg)

def restore(reg):
    return llist("restore", reg)

def stack_inst_reg_name(stack_instruction):
    return head(tail(stack_instruction))
def make_perform_ef(inst, machine, labels, operations, pc):
    action = perform_action(inst)
    if is_operation_exp(action):
        action_fun = make_operation_exp_ef(action, machine, labels, operations)
        def execution_fun():
            action_fun()
            advance_pc(pc)
        return execution_fun
    else:
        error("bad perform instruction -- assemble", inst)
def perform(action):
    return llist("perform", action)

def perform_action(perform_instruction):
    return head(tail(perform_instruction))
def make_execution_function(inst, labels, machine,
                            pc, flag, stack, ops):
    inst_type = type(inst)
    return (make_assign_ef(inst, machine, labels, ops, pc) if inst_type == "assign"
            else make_test_ef(inst, machine, labels, ops, flag, pc) if inst_type == "test"
            else make_branch_ef(inst, machine, labels, flag, pc) if inst_type == "branch"
            else make_go_to_ef(inst, machine, labels, pc) if inst_type == "go_to"
            else make_save_ef(inst, machine, stack, pc) if inst_type == "save"
            else make_restore_ef(inst, machine, stack, pc) if inst_type == "restore"
            else make_push_marker_to_stack_ef(machine, stack, pc) if inst_type == "push_marker_to_stack"
            else make_revert_stack_to_marker_ef(machine, stack, pc) if inst_type == "revert_stack_to_marker"
            else make_perform_ef(inst, machine, labels, ops, pc) if inst_type == "perform"
            else error("unknown instruction type -- assemble", inst))
def make_inst(inst_controller_instruction):
    return pair(inst_controller_instruction, None)
def inst_controller_instruction(inst):
    return head(inst)
def inst_execution_fun(inst):
    return tail(inst)
def set_inst_execution_fun(inst, fun):
    set_tail(inst, fun)
def update_insts(insts, labels, machine):
    pc = get_register(machine, "pc")
    flag = get_register(machine, "flag")
    stack = machine("stack")
    ops = machine("operations")
    return for_each(
        lambda inst: set_inst_execution_fun(
            inst,
            make_execution_function(inst_controller_instruction(inst),
                                    labels, machine, pc, flag, stack, ops)),
        insts)
def make_label_entry(label_name, insts):
    return pair(label_name, insts)
def extract_labels(controller, receive):
    def incorporate(insts, labels):
        next_element = head(controller)
        return (receive(insts,
                        pair(make_label_entry(next_element, insts),
                             labels))
                if is_string(next_element)
                else receive(pair(make_inst(next_element), insts),
                             labels))
    return (receive(None, None) if is_null(controller)
            else extract_labels(tail(controller), incorporate))
def assemble(controller, machine):
    def receive(insts, labels):
        update_insts(insts, labels, machine)
        return insts
    return extract_labels(controller, receive)
def make_stack():
    stack = None
    frame = None
    def push_marker():
        nonlocal frame
        frame = pair(stack, frame)
        return "done"
    def pop_marker():
        nonlocal stack, frame
        stack = head(frame)
        frame = tail(frame)
        return "done"
    def push(x):
        nonlocal stack
        stack = pair(x, stack)
        return "done"
    def pop():
        nonlocal stack
        if is_null(stack):
            error("empty stack -- pop")
        else:
            top = head(stack)
            stack = tail(stack)
            return top
    def initialize():
        nonlocal stack
        stack = None
        return "done"
    def dispatch(message):
        return (push if message == "push"
                else pop() if message == "pop"
                else push_marker() if message == "push_marker"
                else pop_marker() if message == "pop_marker"
                else initialize() if message == "initialize"
                else error("unknown request -- stack", message))
    return dispatch
def make_push_marker_to_stack_ef(machine, stack, pc):
    def execution_fun():
        push_marker(stack)
        advance_pc(pc)
    return execution_fun
def make_revert_stack_to_marker_ef(machine, stack, pc):
    def execution_fun():
        pop_marker(stack)
        advance_pc(pc)
    return execution_fun
def push_marker_to_stack():
    return llist("push_marker_to_stack")
def revert_stack_to_marker():
    return llist("revert_stack_to_marker")
def pop_marker(stack):
    return stack("pop_marker")
def push_marker(stack):
    return stack("push_marker")
def make_register(name):
    contents = "*unassigned*"
    def dispatch(message):
        def set_value(value):
            nonlocal contents
            contents = value
        return (contents if message == "get"
                else set_value if message == "set"
                else error("unknown request -- make_register", message))
    return dispatch
def lookup(key, table):
    record = assoc(key, tail(table))
    return (None
            if is_none(record)
            else tail(record))

def assoc(key, records):
    return (None
            if is_none(records)
            else head(records)
            if key == head(head(records))
            else assoc(key, tail(records)))
def get_contents(register):
    return register("get")
def set_contents(register, value):
    return register("set")(value)
def make_new_machine():
    pc = make_register("pc")
    flag = make_register("flag")
    stack = make_stack()
    the_instruction_sequence = None
    the_ops = llist(llist("initialize_stack", lambda: stack("initialize")))
    register_table = llist(llist("pc", pc), llist("flag", flag))
    def allocate_register(name):
        nonlocal register_table
        if is_undefined(assoc(name, register_table)):
            register_table = pair(llist(name, make_register(name)),
                                  register_table)
        else:
            error("multiply defined register", name)
        return "register allocated"
    def lookup_register(name):
        val = assoc(name, register_table)
        return (error("unknown register", name) if is_undefined(val)
                else head(tail(val)))
    def execute():
        insts = get_contents(pc)
        if is_null(insts):
            return "done"
        else:
            inst_execution_fun(head(insts))()
            return execute()
    def dispatch(message):
        def start():
            set_contents(pc, the_instruction_sequence)
            return execute()
        def install_instruction_sequence(seq):
            nonlocal the_instruction_sequence
            the_instruction_sequence = seq
        def install_operations(ops):
            nonlocal the_ops
            the_ops = append(the_ops, ops)
        return (start() if message == "start"
                else install_instruction_sequence
                     if message == "install_instruction_sequence"
                else allocate_register if message == "allocate_register"
                else lookup_register if message == "get_register"
                else install_operations if message == "install_operations"
                else stack if message == "stack"
                else the_ops if message == "operations"
                else error("unknown request -- machine", message))
    return dispatch
def make_machine(register_names, ops, controller):
    machine = make_new_machine()
    for_each(lambda register_name: machine("allocate_register")(register_name),
             register_names)
    machine("install_operations")(ops)
    machine("install_instruction_sequence")(assemble(controller, machine))
    return machine
def start(machine):
    return machine("start")
def get_register_contents(machine, register_name):
    return get_contents(get_register(machine, register_name))
def set_register_contents(machine, register_name, value):
    set_contents(get_register(machine, register_name), value)
    return "done"
def op(name):
    return llist("op", name)

def is_operation_exp(exp):
    return is_pair(exp) and is_tagged_list(head(exp), "op")

def operation_exp_op(op_exp):
    return head(tail(head(op_exp)))

def operation_exp_operands(op_exp):
    return tail(op_exp)

gcd_machine = make_machine(
    llist("a", "b", "t"),
    llist(llist("rem", lambda a, b: a % b),
         llist("=", lambda a, b: a == b)),
    llist("test_b",
           test(llist(op("="), reg("b"), constant(0))),
           branch(label("gcd_done")),
           assign("t", llist(op("rem"), reg("a"), reg("b"))),
           assign("a", reg("b")),
           assign("b", reg("t")),
           go_to(label("test_b")),
         "gcd_done"))
set_register_contents(gcd_machine, "a", 206)
set_register_contents(gcd_machine, "b", 40)
start(gcd_machine)
get_register_contents(gcd_machine, "a")
