Skip to content

Commit

Permalink
Mark unbound .fvalue value to detect it in FBOUNDP
Browse files Browse the repository at this point in the history
As we're binding the function to the symbol with .bind(), we lose the
identity check for `unboundFunction`.

Instead, mark the function with a special symbol so we can detect the
symbol is unbound.
  • Loading branch information
davazp committed Aug 31, 2022
1 parent 73b9c07 commit b64a8fb
Show file tree
Hide file tree
Showing 4 changed files with 24 additions and 7 deletions.
2 changes: 1 addition & 1 deletion src/compiler/compiler.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -1221,7 +1221,7 @@
(convert-to-bool `(!== (get ,x "value") undefined)))

(define-builtin fboundp (x)
(convert-to-bool `(!== (get ,x "fvalue") (internal |unboundFunction|))))
(convert-to-bool `(call-internal |fboundp| ,x)))

(define-builtin symbol-value (x)
`(call-internal |symbolValue| ,x))
Expand Down
23 changes: 18 additions & 5 deletions src/prelude.js
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,6 @@ internals.forcemv = function(x) {
return typeof x == 'object' && x !== null && 'multiple-value' in x? x: internals.mv(x);
};


//
// Workaround the problems with `new` for arbitrary number of
// arguments. Some primitive constructors (like Date) differ if they
Expand Down Expand Up @@ -331,15 +330,21 @@ packages.KEYWORD = {

jscl.CL = packages.CL.exports;

internals.unboundFunction = function () {
throw new Error("Function '" + this.name + "' undefined");


const UNBOUND = Symbol('UnboundFunction')

internals.makeUnboundFunction = function (symbol) {
const fn = ()=>{ throw new Error("Function '" + symbol.name + "' undefined");}
fn[UNBOUND] = true;
return fn;
};

internals.Symbol = function(name, package_name){
this.name = name;
this.package = package_name;
this.value = undefined;
this.fvalue = internals.unboundFunction.bind(this);
this.fvalue = internals.makeUnboundFunction(this)
this.stack = [];
};

Expand All @@ -352,9 +357,17 @@ internals.symbolValue = function (symbol){
}
};

internals.fboundp = function (symbol) {
if (symbol instanceof internals.Symbol){
return !symbol.fvalue[UNBOUND]
} else {
throw new Error(`${symbol} is not a symbol`)
}
}

internals.symbolFunction = function (symbol){
var fn = symbol.fvalue;
if (fn === internals.unboundFunction)
if (fn[UNBOUND])
symbol.fvalue();
return fn;
};
Expand Down
2 changes: 1 addition & 1 deletion tests/defstruct.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -113,7 +113,7 @@
(test
(mv-eql
(values
(mapcar 'fboundp (list #'sbt-02-a #'sbt-02-p #'copy-sbt-02))
(mapcar 'fboundp (list 'sbt-02-a 'sbt-02-p 'copy-sbt-02))
(sbt-02-con)
(sbt-02-con :foo 99)
(sbt-02-a (sbt-02-con :foo 1234)))
Expand Down
4 changes: 4 additions & 0 deletions tests/variables.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -22,4 +22,8 @@
(let ((*special-defparameter* 2))
(test (= (f) 2))))


(test (not (fboundp 'abc)))


;;; EOF

0 comments on commit b64a8fb

Please sign in to comment.