Commit 0d899a6c authored by Juergen Nickelsen's avatar Juergen Nickelsen
Browse files

finished commenting Object

parent c2727602
......@@ -160,7 +160,7 @@ sub symbol_function {
return $ob->{func};
}
# return an arry with all symbols
# return an array with all symbols
sub all_symbols {
my ($env) = @_;
my @vals = values(%symbols);
......@@ -171,12 +171,14 @@ sub all_symbols {
# a pair is a hash, too: { car => ..., cdr => ... }
# there are no other fields in a hash
# return a new cons made from car and cdr
sub cons {
my ($car, $cdr) = @_;
$cons_counter++;
return bless({ car => $car, cdr => $cdr }, $n_Pair);
}
# get or set the current cons counter, for statistical porpoises
sub cons_count {
my ($new) = @_;
my $count = $cons_counter;
......@@ -184,36 +186,44 @@ sub cons_count {
return $count;
}
sub cadr {
my ($ob) = @_;
return $ob->{cdr}->{car} // $Nil;
}
sub cddr {
my ($ob) = @_;
return $ob->{cdr}->{cdr} // $Nil;
}
# return the car of the object (a cons cell)
sub car {
my ($ob) = @_;
return $ob->{car} // $Nil;
}
# return the cdr of the object (a cons cell)
sub cdr {
my ($ob) = @_;
return $ob->{cdr} // $Nil;
}
# return both the car and the cdr of the object (a cons cell); this is
# redundant, but saves us one function call
sub cxr {
my ($ob) = @_;
return ($ob->{car}, $ob->{cdr});
}
# return the car of the cdr of the object (a cons cell)
sub cadr {
my ($ob) = @_;
return $ob->{cdr}->{car} // $Nil;
}
# return the cdr of the cdr of the object (a cons cell)
sub cddr {
my ($ob) = @_;
return $ob->{cdr}->{cdr} // $Nil;
}
# replace the car of the cons
sub rplaca {
my ($ob, $newcar) = @_;
return $ob->{car} = $newcar;
}
# replace the car of the cons
sub rplacd {
my ($ob, $newcdr) = @_;
return $ob->{cdr} = $newcdr;
......@@ -222,6 +232,7 @@ sub rplacd {
######## Functions
# a hash, too (surprise!): { type => 'expr|subr', spec => $is_special,
# func => $func, doc => $doc, env => $Env }
# create a new function of a Perl function or lambda, is-special flag,
# docstring, name (a symbol, for decoration in print only), and the function
# environment (optional (and currently unused)) or the current one
......@@ -356,55 +367,64 @@ sub is_t {
######## Type function and predicates
# return the (our) type name for the object
sub type_of {
my ($ob) = @_;
return "undef" unless defined($ob);
return ref($ob) || "scalar";
}
# return true iff the object is a list (includes nil)
sub listp {
my ($ob) = @_;
return consp($ob) || is_nil($ob);
}
# return true iff the object is a symbol
sub symbolp {
my ($ob) = @_;
return ref($ob) eq $n_Symbol;
}
# return true iff the object is an environment
sub environmentp {
my ($ob) = @_;
return ref($ob) eq $n_Environment;
}
# return true iff the object is a function
sub functionp {
my ($ob) = @_;
return ref($ob) eq $n_Function;
}
# return true iff the object is a special form
sub specialp {
my ($ob) = @_;
return functionp($ob) && $ob->{spec};
}
# return true iff the object is a number
sub numberp {
my ($ob) = @_;
return ref($ob) eq "" && looks_like_number($ob);
}
# return true iff the object is a string
sub stringp {
my ($ob) = @_;
return ref($ob) eq ""; # && !looks_like_number($ob)
}
# return true iff the object is a pair
sub consp {
my ($ob) = @_;
return ref($ob) eq $n_Pair;
}
######## Initialization
# we do a lots of Global's initialization here, because we need intern() and
# defvar() and want to keep the dependency graph acyclic
# we do a lot of Global's initialization here, because we need intern() and
# defvar() and want to keep cycles out of the dependency graph
sub init {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment