Commit ca1e9dd4 authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

explicit init functions; set() fix made environments work

parent 27cf4c8e

Builtin.pm

+7 −5
Original line number Diff line number Diff line
@@ -995,11 +995,13 @@ my @builtins = # [name, func, is_special, doc] 
      "show all vars in ENV, &optional not in NOPARENTS"],

    );



sub init {

        for my $b (@builtins) {

                my ($name, $func, $is_special, $doc) = @$b;

                my $namesym = intern($name);

                fset($namesym, function($func, $is_special, $doc, $namesym));

                #warn("defined builtin $name");

        }

}



1;

Global.pm

+2 −1
Original line number Diff line number Diff line
@@ -23,7 +23,7 @@ BEGIN { 
                     $the_environment $n_the_environment $n_Environment

                     $n_parentenv $Env $root_Env

                     stacktrace $n_root_environment $root_environment

                     $n_environment_level

                     $n_environment_level $n_env_name

            );

}
@@ -61,6 +61,7 @@ our $n_Environment = 'Environment'; 
our $n_the_environment = '*the-environment*';

our $n_root_environment = '*root-environment*';

our $n_environment_level = '*environment-level*';

our $n_env_name = '*env-name*';



our $n_parentenv = '*parent-environment*';

Lis.pl

+11 −7
Original line number Diff line number Diff line
@@ -10,6 +10,7 @@ use Global; 
use Util;

use Sexp;

use Builtin;

use Print;

use Interp;



# -e -h -l -q -x
@@ -46,6 +47,9 @@ my @argv_save = @ARGV; 
            }

}



Sexp::init();

Builtin::init();

Print::init();

load("Fundamental.lisp", 0, $opt_quiet) or exit(1);



set(intern($n_ARGS), $Nil);

Print.pm

+4 −1
Original line number Diff line number Diff line
@@ -87,6 +87,7 @@ sub print_environment { 
                              $ob->{$n_environment_level},

                              refaddr($ob));

        $result .= join(',', keys(%$ob));

        $result .= '>';

        return $result;

}
@@ -128,6 +129,8 @@ sub print_list { 
        return $result;

}



sub init {

        $Princs = \&princs;

}



1;

Sexp.pm

+38 −31
Original line number Diff line number Diff line
@@ -43,10 +43,12 @@ my $env_level = 0; 
sub new_environment {

        my (@vars) = @_;

        my $env = bless({ $n_parentenv => $Env,

                          $n_environment_level => $env_level++,

                          $n_environment_level => $env_level,

                          $n_env_name => "Env-$env_level",

                          @vars }, $n_Environment);

        warn("new environment[", $Env->{$n_environment_level}, "] ",

             $env);

        $env_level++;

        # warn("new environment[", $env->{$n_environment_level}, "] ",

        #      $env);

        return $env;

}
@@ -60,7 +62,7 @@ sub enter_environment { 
sub leave_environment {

        $Env = $Env->{$n_parentenv};

        set($the_environment, $Env);

        warn("back to environment ", &$Princs($Env));

        # warn("back to environment ", &$Princs($Env));

        $env_level--;

}
@@ -190,12 +192,12 @@ sub set { 
             defined($env);

             $env = $env->{$n_parentenv}) {

                if (exists($env->{$name})) {

                        warn("set $name in ", $env);

                        # warn("set $name in ", $env->{$n_env_name});

                        return $env->{$name} = $value;

                }

        }

        warn("set $name in root ", $root_Env);

        return $root_Env->{$sym} = $value;

        # warn("set $name in ", $root_Env->{$n_env_name});

        return $root_Env->{$name} = $value;

}



sub intern {
@@ -321,7 +323,8 @@ sub symbol_value { 
        for (my $env = $Env;

             defined($env);

             $env = $env->{$n_parentenv}) {

                warn(sprintf("sv search %s in env %s", $ob, $env));

                # warn(sprintf("sv search %s in env %s",

                #              symbol_name($ob), $env->{$n_env_name}));

                if (exists($env->{$name})) {

                        return $env->{$name};

                }
@@ -336,7 +339,7 @@ sub symbol_value_in_env { 
        for (my $env = $Env;

             defined($env);

             $env = $noparents ? undef : $env->{$n_parentenv}) {

                warn(sprintf("svie search %s in env %s", $ob, $env));

                # warn(sprintf("svie search %s in env %s", $ob, $env));

                if (exists($env->{$name})) {

                        return $env->{$name};

                }
@@ -350,6 +353,8 @@ sub symbol_function { 
        return $ob->{func};

}



sub init {



        $Kappa = intern("kappa");

        $Lambda = intern("lambda");

        $andRest = intern("&rest");
@@ -369,6 +374,7 @@ $t_Function = intern("function"); 
        $root_Env = new_environment();  # cannot use enter_environment() here,

                                        # as we don't yet have a $Env

        $Env = $root_Env;

        $root_Env->{$n_env_name} = 'root_Env';

        set($root_environment, $root_Env, $root_Env);

        set($the_environment, $root_Env, $root_Env);
@@ -377,5 +383,6 @@ set($Nil, $Nil, $root_Env); 


        $T = intern("t");

        set($T, $T, $root_Env);

}



1;