From 36dfabf41ef61177f8dba87b58bde0639d8d369a Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Tue, 29 Jan 2013 17:19:01 +0000 Subject: [PATCH] Rename SETCAR and SETCDR to RPLACA and REPLACD respectively And export them --- ecmalisp.js | 26 +++++++++++++------------- ecmalisp.lisp | 35 +++++++++++++++-------------------- 2 files changed, 28 insertions(+), 33 deletions(-) diff --git a/ecmalisp.js b/ecmalisp.js index 78581bc..4f10d35 100644 --- a/ecmalisp.js +++ b/ecmalisp.js @@ -2830,7 +2830,7 @@ var l146 = {name: "%READ-CHAR"}; return (x.cdr = l22.fvalue(pv, (function(){ var tmp = v303; return tmp === l3.value? l3.value: tmp.cdr; - })())); + })()), x); })(); return v304; })((function(){ @@ -3346,7 +3346,7 @@ var l169 = {name: "SET-BINDING-VALUE"}; var x = l35.fvalue(pv, v368); if (typeof x != 'object') throw 'The value ' + x + ' is not a type object.'; - return (x.car = v369); + return (x.car = v369, x); })(); })(); })); @@ -3364,7 +3364,7 @@ var l170 = {name: "SET-BINDING-DECLARATIONS"}; var x = l37.fvalue(pv, v371); if (typeof x != 'object') throw 'The value ' + x + ' is not a type object.'; - return (x.car = v372); + return (x.car = v372, x); })(); })(); })); @@ -3427,7 +3427,7 @@ var l176 = {name: "GOTAG"}; return (x.car = ({car: v380, cdr: (function(){ var tmp = v381; return tmp === l3.value? l3.value: tmp.car; - })()})); + })()}), x); })() : (l26.fvalue(pv, v383, l99) !== l3.value ? (function(){ var x = (function(){ var tmp = v381; @@ -3435,17 +3435,17 @@ var l176 = {name: "GOTAG"}; })(); if (typeof x != 'object') throw 'The value ' + x + ' is not a type object.'; - return (x.car = ({car: v380, cdr: l33.fvalue(pv, v381)})); + return (x.car = ({car: v380, cdr: l33.fvalue(pv, v381)}), x); })() : (l26.fvalue(pv, v383, l175) !== l3.value ? (function(){ var x = l35.fvalue(pv, v381); if (typeof x != 'object') throw 'The value ' + x + ' is not a type object.'; - return (x.car = ({car: v380, cdr: l36.fvalue(pv, v381)})); + return (x.car = ({car: v380, cdr: l36.fvalue(pv, v381)}), x); })() : (l26.fvalue(pv, v383, l176) !== l3.value ? (function(){ var x = l37.fvalue(pv, v381); if (typeof x != 'object') throw 'The value ' + x + ' is not a type object.'; - return (x.car = ({car: v380, cdr: l38.fvalue(pv, v381)})); + return (x.car = ({car: v380, cdr: l38.fvalue(pv, v381)}), x); })() : (function(){ throw "ECASE expression failed."; })())))); @@ -6312,7 +6312,7 @@ var l270 = {name: "FLOOR"}; if (value === undefined) throw "Variable `" + symbol.name + "' is unbound."; return value; })()})); -var l271 = {name: "SETCAR"}; +var l271 = {name: "RPLACA"}; ((l255).value = ({car: l43.fvalue(pv, l271, (function (values,v671,v672){ checkArgs(arguments, 3); return (function(){ @@ -6337,7 +6337,7 @@ var l271 = {name: "SETCAR"}; var value = symbol.value; if (value === undefined) throw "Variable `" + symbol.name + "' is unbound."; return value; - })())), l125.fvalue(pv, "return ", l125.fvalue(pv, "(x.car = ", v674, ")"), ";", (function(){ + })())), l125.fvalue(pv, "return ", l125.fvalue(pv, "(x.car = ", v674, ", x)"), ";", (function(){ var symbol = l124; var value = symbol.value; if (value === undefined) throw "Variable `" + symbol.name + "' is unbound."; @@ -6351,7 +6351,7 @@ var l271 = {name: "SETCAR"}; if (value === undefined) throw "Variable `" + symbol.name + "' is unbound."; return value; })()})); -var l272 = {name: "SETCDR"}; +var l272 = {name: "RPLACD"}; ((l255).value = ({car: l43.fvalue(pv, l272, (function (values,v675,v676){ checkArgs(arguments, 3); return (function(){ @@ -6376,7 +6376,7 @@ var l272 = {name: "SETCDR"}; var value = symbol.value; if (value === undefined) throw "Variable `" + symbol.name + "' is unbound."; return value; - })())), l125.fvalue(pv, "return ", l125.fvalue(pv, "(x.cdr = ", v678, ")"), ";", (function(){ + })())), l125.fvalue(pv, "return ", l125.fvalue(pv, "(x.cdr = ", v678, ", x)"), ";", (function(){ var symbol = l124; var value = symbol.value; if (value === undefined) throw "Variable `" + symbol.name + "' is unbound."; @@ -7531,7 +7531,7 @@ var l305 = {name: "LS-MACROEXPAND-1"}; return l305; })(); var l306 = {name: "COMPILE-FUNCALL"}; -var l307 = {name: "G764"}; +var l307 = {name: "G922"}; (function(){ (l306).fvalue = (function(v788){ ((v788)["fname"] = "COMPILE-FUNCALL"); @@ -7792,7 +7792,7 @@ var l308 = {name: "LS-COMPILE-TOPLEVEL"}; return l228; })(); var l309 = {name: "&BODY"}; -var l310 = QIList(l203,l202,l309,l20,l15,l116,l60,l61,l21,l22,l23,l266,l268,l19,l19,l265,l267,l53,l63,l289,l301,l300,l302,l92,l44,l175,l18,l18,l82,l32,l38,l36,l33,l30,l30,l51,l242,l34,l37,l35,l31,l31,l287,l74,l75,l73,l50,l28,l29,l72,l46,l2,l9,l11,l1,l8,l87,l96,l98,l48,l49,l52,l280,l26,l281,l291,l228,l91,l122,l95,l106,l120,l39,l42,l276,l288,l99,l297,l16,l123,l249,l71,l200,l117,l45,l76,l76,l121,l114,l5,l81,l68,l233,l237,l102,l43,l58,l299,l103,l274,l70,l83,l78,l262,l134,l251,l135,l252,l3,l27,l80,l79,l12,l269,l54,l107,l109,l105,l77,l140,l143,l197,l55,l56,l229,l66,l47,l158,l84,l85,l86,l13,l241,l64,l65,l40,l216,l217,l90,l284,l93,l94,l283,l88,l225,l275,l115,l278,l277,l273,l4,l248,l41,l243,l25,l7,l250,l133,l132,l100,l142,l6,l97,l298,l24,l3); +var l310 = QIList(l203,l202,l309,l20,l15,l116,l60,l61,l21,l22,l23,l266,l268,l19,l19,l265,l267,l53,l63,l289,l301,l300,l302,l92,l44,l175,l18,l18,l82,l32,l38,l36,l33,l30,l30,l51,l242,l34,l37,l35,l31,l31,l287,l74,l75,l73,l50,l28,l29,l72,l46,l2,l9,l11,l1,l8,l87,l96,l98,l48,l49,l52,l280,l26,l281,l291,l228,l91,l122,l95,l106,l120,l39,l42,l276,l288,l99,l297,l16,l123,l249,l71,l200,l117,l45,l76,l76,l121,l114,l5,l81,l68,l233,l237,l102,l43,l58,l299,l103,l274,l70,l83,l78,l262,l134,l251,l135,l252,l3,l27,l80,l79,l12,l269,l54,l107,l109,l105,l77,l140,l143,l197,l55,l56,l229,l66,l47,l158,l84,l85,l86,l13,l241,l64,l65,l271,l272,l40,l216,l217,l90,l284,l93,l94,l283,l88,l225,l275,l115,l278,l277,l273,l4,l248,l41,l243,l25,l7,l250,l133,l132,l100,l142,l6,l97,l298,l24,l3); l122.fvalue(values, l310); ((l116).value = (function(){ var symbol = l112; diff --git a/ecmalisp.lisp b/ecmalisp.lisp index d880614..8574222 100644 --- a/ecmalisp.lisp +++ b/ecmalisp.lisp @@ -623,11 +623,6 @@ (defun concat-two (s1 s2) (concatenate 'string s1 s2)) - (defun setcar (cons new) - (setf (car cons) new)) - (defun setcdr (cons new) - (setf (cdr cons) new)) - (defun aset (array idx value) (setf (aref array idx) value))) @@ -821,7 +816,7 @@ (defun %read-char (stream) (and (< (cdr stream) (length (car stream))) (prog1 (char (car stream) (cdr stream)) - (setcdr stream (1+ (cdr stream)))))) + (rplacd stream (1+ (cdr stream)))))) (defun whitespacep (ch) (or (char= ch #\space) (char= ch #\newline) (char= ch #\tab))) @@ -1010,10 +1005,10 @@ (defun binding-declarations (b) (fourth b)) (defun set-binding-value (b value) - (setcar (cddr b) value)) + (rplaca (cddr b) value)) (defun set-binding-declarations (b value) - (setcar (cdddr b) value)) + (rplaca (cdddr b) value)) (defun push-binding-declaration (decl b) (set-binding-declarations b (cons decl (binding-declarations b)))) @@ -1027,10 +1022,10 @@ (defun push-to-lexenv (binding lexenv namespace) (ecase namespace - (variable (setcar lexenv (cons binding (car lexenv)))) - (function (setcar (cdr lexenv) (cons binding (cadr lexenv)))) - (block (setcar (cddr lexenv) (cons binding (caddr lexenv)))) - (gotag (setcar (cdddr lexenv) (cons binding (cadddr lexenv)))))) + (variable (rplaca lexenv (cons binding (car lexenv)))) + (function (rplaca (cdr lexenv) (cons binding (cadr lexenv)))) + (block (rplaca (cddr lexenv) (cons binding (caddr lexenv)))) + (gotag (rplaca (cdddr lexenv) (cons binding (cadddr lexenv)))))) (defun extend-lexenv (bindings lexenv namespace) (let ((env (copy-lexenv lexenv))) @@ -1820,13 +1815,13 @@ (ls-compile nil) ": tmp.cdr;" *newline*)) -(define-builtin setcar (x new) +(define-builtin rplaca (x new) (type-check (("x" "object" x)) - (concat "(x.car = " new ")"))) + (concat "(x.car = " new ", x)"))) -(define-builtin setcdr (x new) +(define-builtin rplacd (x new) (type-check (("x" "object" x)) - (concat "(x.cdr = " new ")"))) + (concat "(x.cdr = " new ", x)"))) (define-builtin symbolp (x) (js!bool @@ -2133,10 +2128,10 @@ nth nthcdr null numberp or package-name package-use-list packagep plusp prin1-to-string print proclaim prog1 prog2 progn psetq push quote remove remove-if remove-if-not return return-from revappend - reverse second set setq some string-upcase string string= stringp - subseq symbol-function symbol-name symbol-package symbol-plist - symbol-value symbolp t tagbody third throw truncate unless - unwind-protect values values-list variable warn when write-line + reverse rplaca rplacd second set setq some string-upcase string + string= stringp subseq symbol-function symbol-name symbol-package + symbol-plist symbol-value symbolp t tagbody third throw truncate + unless unwind-protect values values-list variable warn when write-line write-string zerop)) (setq *package* *user-package*) -- 1.7.10.4