ref: 86a953cd83d7d4ff8e4940b6469659af9cfede49
parent: c588f67dd266c25cca8634d03f259a38573a1c7e
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Apr 24 11:50:04 EDT 2025
make "list?" behave as in CL; add "proper-list?" proper-list? will detect circular and dotted lists. On the other hand, list? will only test for NIL and cons.
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -13,7 +13,7 @@
#fn("z0700}2:" #(aset!) 6) NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL #fn("n3012082>1|:" #(#fn("n1A061:" 6)) 7) NIL NIL NIL NIL NIL NIL NIL NIL #fn("z0700}2:" #(aref) 6) NIL NIL)*properties* #table(*formals-list* #table(identity ((x)) bound? ((symbol)) sym-set-doc ((symbol
- doc-seq . formals-list)) io-eof? ((io)) < ((a . rest)) cadr ((cell)) sym (term) nan? ((v)) for ((min
+ doc-seq . formals-list)) list? ((a)) io-eof? ((io)) < ((a . rest)) cadr ((cell)) sym (term) nan? ((v)) for ((min
max fn)) fixnum? ((v)) exit (((status NIL))) > ((a . rest)) + (rest) div0 ((a b)) __finish ((status)) lz-unpack ((data
:to destination)
(data :size decompressed-bytes)) defstruct ((name docs… options… (slot-1 DEFAULT) slot-2 slot-3)
@@ -20,7 +20,7 @@
(name (:type 'vec) (:named T) (:constructor T) (:conc-name
T)
(:predicate T) . slots)) compare ((x y)) buffer (NIL) num? ((v)) add-exit-hook ((fun)) rand-float (NIL) builtin? ((v)) set-car! ((cell
- new-first)) cons? ((v)) doc-group ((group-name doc)) 1+ ((n)) aref ((sequence subscript0 . rest)) zero? ((x)) vec (rest) >= ((a . rest)) sym? ((v)) void? ((x)) length= ((seq
+ new-first)) cons? ((v)) doc-group ((group-name doc)) 1+ ((n)) aref ((sequence subscript0 . rest)) zero? ((x)) vec (rest) >= ((a . rest)) sym? ((v)) void? ((x)) proper-list? ((a)) length= ((seq
n)) positive? ((x)) doc-for ((term . doc)) aset! ((sequence subscripts… new-value)) car ((lst)) <= ((a . rest)) str (term) cons ((first
second)) - ((a . rest)) remprop ((symbol key)) negative? ((x)) rand (NIL) void (rest) file ((path
(:read NIL) (:write NIL) (:create NIL) (:truncate NIL) (:append NIL))) rand-double (NIL) 1- ((n)) atom? ((value)) cdr ((lst)) vec? ((v)) / ((x . rest)) equal? ((a
@@ -29,12 +29,12 @@
(doc NIL))) set-cdr! ((cell new-second)) fn? ((v)) help-print-header ((term sigs (:kind NIL)
(:lpad ""))) lz-pack ((data
(level 0))) *prompt* (NIL) eq? ((a b)) getprop ((symbol key (def NIL))) vm-stats (NIL) * (rest) putprop ((symbol
- key val)) io->str ((io))) *doc* #table(identity "Return `x`." bound? "Return `T` if `symbol` has a value associated with it, `NIL` otherwise." sym-set-doc "Set the documentation for the symbol." io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise." (doc
+ key val)) io->str ((io))) *doc* #table(identity "Return `x`." bound? "Return `T` if `symbol` has a value associated with it, `NIL` otherwise." sym-set-doc "Set the documentation for the symbol." list? "Return `T` if the value is either `NIL` or a cons cell, `NIL`\notherwise." io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise." (doc
group io) "I/O functionality." < "Return `T` if the arguments are in strictly increasing order (next\none is greater than the previous one). With a single argument\nthe result is always `T`." cadr "Shorthand for `(car (cdr cell))`, that is, _first element of the\nsecond element_.\n\nExamples:\n\n (cadr '(1 2 3)) → 2\n (cadr '(1)) → NIL\n (cadr NIL) → NIL" sym "Return a symbol with the name being the concatenation of terms\nformatted as strings.\n\nThis is equivalent to `(sym (str terms…))`.\n\nExamples:\n\n (sym \"a\" 'b 1) → ab1" (doc
group builtin) "Built-in operators." nan? "Return `T` if `v` is a floating point representation of NaN, either\nnegative or positive, `NIL` otherwise." NIL "An empty list. Can be used as the opposite of T in boolean\nexpressions.\n\nExamples:\n\n (not NIL) → T\n (if NIL 'yes 'no) → no\n (car NIL) → NIL\n (cdr NIL) → NIL" for "Call the function `fn` with a single integer argument, starting from\n`min` and ending with `max`.\n\nExamples:\n\n (for 0 2 (λ (i) (print (- 2 i)))) → 210" (doc
group vm) "VM-related functions." exit "Terminate the process with the specified status. Does not return.\nThe status is expected to be a string in case of an error.\n\nExamples:\n\n (exit) ; exit with status 0 (nil on Plan 9)\n (exit \"error\") ; exit with status 1 (\"error\" on Plan 9)" fixnum? "Return `T` if `v` is of a fixnum type, `NIL` otherwise." > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)." + "Return sum of the arguments or `0` when none specified." div0 "Return the quotient of two numbers. For non-integers this is\nequivalent to `(div0 (floor a) (floor b))`. The result is always an\ninteger.\n\nExamples:\n\n (div0 7 2) → 3\n (div0 10 -2) → -5\n (div0 6.9 1.9) → 6" (doc
group prop) "Dealing with symbols' properties." lz-unpack "Return decompressed data previously compressed using lz-pack.\n\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified. In the latter case a new\narray is allocated." __finish "A function called right before exit by the VM." defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`), where\nthe first element is the name of the structure's type, the rest are\nthe keyworded slot values. A list with slot values alone can be used\ninstead by adding `:type list` option. The list will not contain the\nname of the struct by default, which can be enabled with `:named T`\noption.\n\nAs an example, the following declaration\n\n (defstruct blah \"Return stuff.\" :doc-group stuff a b (c 1 :read-only T))\n\nGenerates the default constructor for a structure of three slots, with\nthe third (`c`) having a specific default value and being read-only.\n\n (make-blah (:a NIL) (:b NIL) (:c 1))\n (blah-a s)\n (blah-b s)\n (blah-c s)\n\nSlot's options, if any, should be specified after its default value.\nSupported options are:\n\n ; mark the slot as read-only\n ; its value can be read, but trying to modify it will throw an error\n … :read-only T\n\nThe constructor can be changed in several ways:\n\n ; disable the constructor altogether\n (defstruct blah :constructor NIL a b c)\n ; only change its name\n (defstruct blah :constructor blargh a b c)\n ; rename AND avoid using keywords\n (defstruct blah :constructor (blah a b c) a b c)\n\nThe option `:conc-name` specifies the slot accessor prefix, which\ndefaults to `structname-`. Prefix can be disabled entirely with\n`:conc-name NIL`.\n\nDefault predicate can be disabled or its name, which defaults to\n`structname?`, changed:\n\n ; use \"blargh?\" instead of \"blah?\"\n (defstruct blah :predicate blargh? a b c)\n ; without predicate\n (defstruct blah :predicate NIL a b c)" (doc
- group rand) "Random numbers generation." (doc group compare) "Comparison operators." compare "Return -1 if `x` is less than `y`, 0 if equal, and `1` if `y` is\ngreater than `x`.\n\nExamples:\n\n (compare 'a 'b) → -1\n (compare 1 1) → 0\n (compare \"b\" \"a\") → 1" buffer "Return an in-memory buffer for I/O, of `io` type.\n\nA buffer can be used for both reading and writing at the same\ntime." num? "Return `T` if `v` is of a numerical type, `NIL` otherwise.\n\nNumerical types include floating point, fixnum, bignum, etc.\nNote: ironically, a NaN value is considered a number by this function\nsince it's only testing the _type_ of the value." add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\n\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) `NIL` on success and a string describing\nan error otherwise." rand-float "Return a random float on [0.0, 1.0] interval." builtin? "Return `T` if `v` is a built-in function implemented in C, `NIL`\notherwise.\n\nExamples:\n\n (builtin? map) → T\n (builtin? macroexpand) → NIL" set-car! "Modify a cons cell (a list) in-place by putting `new-first` as its\nfirst element (head of the list). Return the modified cons\ncell (list).\n\nExamples:\n\n (def q '(1 2 3 4 5))\n (set-car! q 0) → (0 6 7)\n q → (0 6 7)" doc-group "Define documentation for a group." cons? "Return `T` if `v` is a cons cell, `NIL` otherwise.\n\nExamples:\n\n (cons? 0) → NIL\n (cons? NIL) → NIL\n (cons? '(1)) → T" 1+ "Equivalent to `(+ n 1)`." aref "Return the sequence element specified by the subscripts. The sequence\ncan be an array, vector, a list. Multi-dimensional sequences\nof variating types are also supported.\n\nExamples:\n\n (def a '((1 #(2 (3)) 4)))\n (aref a 0) → (1 (2 (3)) 4)\n (aref a 1) → index 1 out of bounds\n (aref a 0 0) → 1\n (aref a 0 1 0) → 2\n (aref a 0 2) → 4" *properties* "All properties of symbols recorded with `putprop` are recorded in this\ntable." vec "Return a vector constructed of the arguments.\n\nExamples:\n\n (vec) → #() ; empty vector\n (vec 1 2.5 \"a\" 'b) → #(1 2.5 \"a\" b)" >= "Return `T` if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." sym? "Return `T` if `v` is a symbol, `NIL` otherwise." void? "Return `T` if `x` is `#<void>`, `NIL` otherwise." zero? "Return `T` if `x` is zero." length= "Perform a bounded length test.\n\nUse this instead of `(= (length seq) n)`, since it avoids unnecessary\nwork and always terminates." positive? "Return `T` if `x` is greater than zero." doc-for "Define documentation for a top level term.\n\nIf `term` is a function signature and `doc` is not specified, just\nthe signature will be included in the documentation, without\nreplacing any previously defined.\n\nFirst `doc` argument is supposed to be a string with the description\nof the term. The following arguments are expected to be optional tag\npairings that provide grouping for multiple symbols and \"see also\"\nreferences.\n\nUseful in cases where setting the documentation for a term can't\n(or not preferred to) be made during the definition of said term.\nOne of those reasons is that the term is a built-in function\nimplemented in C.\n\nExamples:\n\n (doc-for (func arg (arg2 0))\n \"Return something about the `arg` and `arg2`. This is a short\n description.\n\n This is the longer description, following the short one.\n\n Examples:\n\n (func 0) → T\n (func 1 3) → NIL\"\n :doc-group stuff\n :doc-see func2)\n (doc-for (func arg (:another-variant NIL)))" aset! "Modify the sequence element specified by the subscripts and return the\nnew value. The sequence can be an array, vector, a list.\nMulti-dimensional sequences of variating types are also supported.\n\nExamples:\n\n (def a '((1 #(2 (3)) 4)))\n (aset! a 1 'x) → index 1
\ No newline at end of file
+ group rand) "Random numbers generation." (doc group compare) "Comparison operators." compare "Return -1 if `x` is less than `y`, 0 if equal, and `1` if `y` is\ngreater than `x`.\n\nExamples:\n\n (compare 'a 'b) → -1\n (compare 1 1) → 0\n (compare \"b\" \"a\") → 1" buffer "Return an in-memory buffer for I/O, of `io` type.\n\nA buffer can be used for both reading and writing at the same\ntime." num? "Return `T` if `v` is of a numerical type, `NIL` otherwise.\n\nNumerical types include floating point, fixnum, bignum, etc.\nNote: ironically, a NaN value is considered a number by this function\nsince it's only testing the _type_ of the value." add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\n\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) `NIL` on success and a string describing\nan error otherwise." rand-float "Return a random float on [0.0, 1.0] interval." builtin? "Return `T` if `v` is a built-in function implemented in C, `NIL`\notherwise.\n\nExamples:\n\n (builtin? map) → T\n (builtin? macroexpand) → NIL" set-car! "Modify a cons cell (a list) in-place by putting `new-first` as its\nfirst element (head of the list). Return the modified cons\ncell (list).\n\nExamples:\n\n (def q '(1 2 3 4 5))\n (set-car! q 0) → (0 6 7)\n q → (0 6 7)" doc-group "Define documentation for a group." cons? "Return `T` if `v` is a cons cell, `NIL` otherwise.\n\nExamples:\n\n (cons? 0) → NIL\n (cons? NIL) → NIL\n (cons? '(1)) → T" 1+ "Equivalent to `(+ n 1)`." aref "Return the sequence element specified by the subscripts. The sequence\ncan be an array, vector, a list. Multi-dimensional sequences\nof variating types are also supported.\n\nExamples:\n\n (def a '((1 #(2 (3)) 4)))\n (aref a 0) → (1 (2 (3)) 4)\n (aref a 1) → index 1 out of bounds\n (aref a 0 0) → 1\n (aref a 0 1 0) → 2\n (aref a 0 2) → 4" *properties* "All properties of symbols recorded with `putprop` are recorded in this\ntable." vec "Return a vector constructed of the arguments.\n\nExamples:\n\n (vec) → #() ; empty vector\n (vec 1 2.5 \"a\" 'b) → #(1 2.5 \"a\" b)" >= "Return `T` if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." sym? "Return `T` if `v` is a symbol, `NIL` otherwise." void? "Return `T` if `x` is `#<void>`, `NIL` otherwise." zero? "Return `T` if `x` is zero." proper-list? "Return `T` is the value is a proper list. That is, a non-circular\nlist with the last element being `NIL`, as opposed to a dotted list.\n\nExamples:\n\n (proper-list? NIL) → T\n (proper-list? '(1)) → T\n (proper-list? '(1 . 2) → NIL\n (def l '(1))\n (set-cdr! l l) → #0=(1 . #0#)\n (length l) → +inf.0\n (proper-list? l) → NIL" length= "Perform a bounded length test.\n\nUse this instead of `(= (length seq) n)`, since it avoids unnecessary\nwork and always terminates." positive? "Return `T` if `x` is greater than zero." doc-for "Define documentation for a top level term.\n\nIf `term` is a function signature and `doc` is not specified, just\nthe signature will be included in the documentation, without\nreplacing any previously defined.\n\nFirst `doc` argument is supposed to be a string with the description\nof the term. The following arguments are expected to be optional tag\npairings that provide grouping for multiple symbols and \"see also\"\nreferences.\n\nUseful in cases where setting the documentation for a term can't\n(or not preferred to) be made during the definition of said term.\nOne of those reasons is that the term is a built-in function\nimplemented in C.\n\nExamples:\n\n (doc-for (func arg (arg2 0))\n \"Return something about the `arg` and `arg2`. This is a short\n description.\n\n This is the longer description, following the short one.\n\n Examples:\n\n (func 0) → T\n
\ No newline at end of file
out of bounds\n (aset! a 0 0 'x) → x\n a → ((x #(2 (3)) 4))\n (aset! a 0 1 9) → 9\n a → ((x #(9 (3)) 4))" T "A boolean \"true\".\n\nExamples:\n\n (not T) → NIL\n (if T 'yes 'no) → yes" car "Return the first element of a cons cell (head of a list) or `NIL` if\nnot available.\n\nExamples:\n\n (car NIL) → NIL\n (car '(1 2 3)) → 1\n (car '(1 . 2)) → 1" *builtins* "VM instructions as closures." str "Return concatenation of terms formatted as strings.\n\nThis is equivalent to `(princ terms…)`, except the string is\nreturned, rather than printed.\n\nExamples:\n\n (str \"a\" 'b 1 #(0)) → \"ab1#(0)\"" cons "Return a cons cell containing two arguments.\n\nExamples:\n\n (cons 1 2) → (1 . 2)\n (cons 1 '(2)) → (1 2)\n (cons 1 (cons 2 (cons 3 NIL))) → (1 2 3)" - "Return the result of subtraction. With only one argument a\nnegation is performed.\n\nExamples:\n\n (- 1.5) → -1.5\n (- 3 2) → 1" remprop "Remove a property value associated with the symbol." <= "Return `T` if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." rand "Return a random non-negative fixnum on its maximum range." void "Return the constant `#<void>` while ignoring any arguments.\n\n`#<void>` is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though `T` or `NIL` could\nbe returned instead, in case of `#<void>` alone, REPL will not print\nit." negative? "Return `T` if `x` is negative." (doc
group list) "Working with lists." Instructions "VM instructions mapped to their encoded byte representation." file "Open a file for I/O.\n\nAn `io` object is returned. Without any modes specified the file\nis opened in read-only mode." rand-double "Return a random double on interval [0.0, 1.0]." 1- "Equivalent to `(- n 1)`." cdr "Return the second element of a cons cell (tail of a list) or `NIL` if\nnot available.\n\nExamples:\n\n (cdr NIL) → NIL\n (cdr '(1 2 3)) → (2 3)\n (cdr '(1 . 2)) → 2" (doc
group string) "String-related functionality." atom? "Return `T` if `v` is a _not_ a cons cell, `NIL` otherwise. This is\nthe opposite of `cons?`.\n\nThe term \"atom\" comes from the idea of being indivisible.\n\nExamples:\n\n (atom? \"a\") → T\n (atom? NIL) → T\n (atom? '(1)) → NIL" vec? "Return `T` if `v` is a vector, `NIL` otherwise." equal? "Return `T` if both `a` and `b` are of the same value. For non-leaf\ntypes (cons cell and vector), the equality test is performed\nthroughout the whole structure of the values.\n\nExamples:\n\n (equal? 0.0 0) → NIL\n (equal? 0 0) → T\n (def a \"1\")\n (def b \"1\")\n (equal? a b) → T\n (def a '(1))\n (def b '(1))\n (equal? a b) → T" / "Return the division of the arguments. With only one argument the\nresult of `1/x` is returned. If the result is integer-valued, it is\nreturned as an integer.\n\nExamples:\n\n (/ 2) → 0.5\n (/ 7 2 2) → 1.75\n (/ 10 -2) → -5 ; a fixnum\n (/ 6.9 1.9) → 3.6315…" eqv? "Return `T` if both `a` and `b` are of the same value and primitive\n(leaf) type, `NIL` otherwise. Neither cons cell nor vector are not\nconsidered primitive types as they may define deep structures.\n\nExamples:\n\n (eqv? 0.0 0) → NIL\n (eqv? 0 0) → T\n (def a \"1\")\n (def b \"1\")\n (eqv? a b) → T\n (def a '(1))\n (def b '(1))\n (eqv? a b) → NIL" io? "Return `T` if `term` is of `io` type, `NIL` otherwise." eof-object? "Return `T` if `term` is `#<eof>`, `NIL` otherwise.\n\nThis object is returned by I/O functions to signal end of file,\nwhere applicable." list "Return a list constructed of the arguments.\n\nExamples:\n\n (list) → NIL ; empty list\n (list 1 2.5 \"a\" 'b) → (1 2.5 \"a\" b)" apply "Return the result of applying a function to a list of arguments.\n\nThe last argument must always be a list which gets spliced as\narguments to the function.\n\nExamples:\n\n (apply + 1 2 '(3 4 5)) → 15\n (apply vec '(1 2 3)) → #(3 4 5)\n (apply arr 'u8 '(3 4 5)) → #vu8(3 4 5)" help "Display documentation the specified term, if available.\n\nThe optional parameter `kind` can be set to `group` to show\ndocumentation for the specified group instead of a single term.\nAll available documentation groups can be displayed with `(help\ngroups)`." (doc
@@ -54,10 +54,10 @@
((:doc-group . builtin)) str ((:doc-group . string)) cons ((:doc-group . list)
(:doc-group . builtin)) - ((:doc-group . builtin)) remprop ((:doc-group . prop)) <= ((:doc-group . compare)) rand ((:doc-group . rand)) negative? ((:doc-group . compare)) Instructions ((:doc-group . builtin)) file ((:doc-group . io)) rand-double ((:doc-group . rand)) cdr ((:doc-group . list)
(:doc-group . builtin)) atom? ((:doc-group . builtin)) vec? ((:doc-group . builtin)) / ((:doc-group . builtin)) equal? ((:doc-group . compare)
-? ((:doc-group . builtin)) vec? ((:doc-group . builtin)) / ((:doc-group . builtin)) equal? ((:doc-group . compare)
+-group . builtin)) str ((:doc-group . string)) cons ((:doc-group . list)
eqv? ((:doc-group . compare) (:doc-group . builtin)) io? ((:doc-group . io)) eof-object? ((:doc-group . io)) list ((:doc-group . builtin)) apply ((:doc-group . builtin)) help ((:doc-group . doc)) rand-u32 ((:doc-group . rand)) = ((:doc-group . compare)
(:doc-group . builtin)) rand-u64 ((:doc-group . rand)) not ((:doc-group . builtin)) separate-doc-from-body ((:doc-group . doc)) set-cdr! ((:doc-group . list)
-up . list)
+? ((:doc-group . compare) (:doc-group . builtin)) io? ((:doc-group . io)) eof-object? ((:doc-group . io)) list ((:doc-group . builtin)) apply ((:doc-group . builtin)) help ((:doc-group . doc)) rand-u32 ((:doc-group . rand)) = ((:doc-group . compare)
-group . doc)) lz-pack ((:doc-group . compress)) arg-counts ((:doc-group . builtin)) eq? ((:doc-group . compare)
(:doc-group . builtin)) getprop ((:doc-group . prop) (:doc-see . putprop)) vm-stats ((:doc-group . vm)) * ((:doc-group . builtin)) putprop ((:doc-group . prop)
(:doc-see . getprop)) io->str ((:doc-group . io))))
@@ -100,7 +100,7 @@
089;J5048:3\xe3082888:2C154475882D527E2F8@527E2G8@52893H07H7I2J898A535147K50@30q48B3W07K5047H2L5147K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
0) help-print-header #fn(sym) ":doc-" doc getprop *doc* *formals-list* #0#
#fn("n313?02021820>2162:72504738251474061:" #(#fn(for-each)- #fn("n17050471A51472F0P61:" #(newline princ print) 7)+88:2C154475882D527E2F8@527E2G8@52893H07H7I2J898A535147K50@30q48B3W07K5047H2L5147K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header
3;0220E8563:0:" #(#fn(str-find) "\n" #fn(str-sub)) first-line 9)
#fn("n10B;3B040<20Q;38040T21Q:" #(doc group) doc-group? 6) #fn("n10H;3?0470A710225262:" #(member getprop *doc-extra*) doc-extra-term? 9)@@ -110,7 +110,7 @@
A<070021522263:" #(getprop *formals-list* " ") 9)
void "no help for " #fn(str) " " "" " (undefined)") 21) defstruct #fn("z0700=5185<85=0<I21228887>2?9514863H0738874862589Pe15252@30q42627e188e178875163:" #(separate-doc-from-body #0# #fn("n12002152853=0220E8553@300853<02208552@402324752627AF5351285229862:7;882<528764:" #(#fn(str-find)-to-str #fn(list*) defstruct "\n" #fn(str) "\n\n "
+9) "Members:" #fn("n1A<070021522263:" #(getprop *formals-list* " ") 9) -fmt #fn(nconc) %defstruct% copy-list) 15) bcode:ctable #fn("n1200Ke3:" #(aref) 7) with-output-to #fn("z12021e1220e2e1e17315163:" #(#fn(nconc) with-bindings *io-out* copy-list) 9) catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch λ #:g470 if and cons? eq? car quote thrown-value cadr caddr raise) 15) let* #fn("z10H3E02021e1qe17215153e1:2021e173051e1e1720=B3H02024e10=e17215153e1@301515375051e2:" #(#fn(nconc)@@ -309,7 +309,7 @@
>= 1- " >" " " hex5
": " " ") print-inst 10)
#fn(length) #fn(table-foldl) #fn("n382;J@041AF<Gl2;34040:" 7) Instructions #fn("n1702161:" #(princ-ada seta loadc call tcall list + - * / < = vec argc vargc loadi8 apply tapply closure box
+ne fn-disasm print) print-val 9)
ply tapply closure box
shift aref) #fn(num->str) aref (loada.l seta.l loadc.l argc.l vargc.l call.l tcall.l box.l) (optargs
keyargs) keyargs " " bounda (jmp brne brnn brn) "@" hex5 ref-s16-LE (jmp.l brne.l brnn.l brn.l)) fn-disasm 20)
@@ -337,7 +337,7 @@
#fn(str)
#fn(str-sub)
#fn(str-length)) keyword->sym 11)
- #fn(str-length)) keyword->sym 11)
+-int
g? #fn("n10B;3904200<61:" #(#fn(keyword?)) keyword-arg? 6) lambda-vars #fn("n1Ib520852185>1_51485<00qq54422237405162:" #(#0# #fn("n40S;J5040R340D:0B3Z00<R3T082;J504833<0702112263:A<0=1828364:0B3\xa500<B3\x9f073051R3Y0740<r252;JF04740<r352;390475051R360q@=070260<2715442873051513=0A<0=182D64:833<0702112963:A<0=1D8364:0B3>0702:0<27164:01C:07021162:702:027164:" #(compile-error@@ -437,6 +437,8 @@
ption: " newline) print-exception 16)
print-stack-trace #fn("n1IIb5b620852185>1_51420862285>1_5147374252627505252Eb82829868788>37:05162:" #(#0# #fn("n32005182P2105121151C?022232487e361:25051E76278851512888A187>4|:" #(#fn(fn-name)+nstant: " print io-error "I/O error: " assert-failed "assertion failed: "
+ divide-error memory-error "*** Unhandled exception: " newline) print-exception 16)
#fn(fn-code)
#fn(raise) thrown-value
ffound #fn(fn-vals) 1-
@@ -525,7 +527,7 @@
#(#0#
#fn("n10H3700:@30q40<85B3I07085r2523>07185Er253@4085A<0=51P:" #(length> subseq) formals-clean 9) #fn(str?) #fn(map) str-join #fn(str-split) "\n" any #fn("n1E20051L2;3B04210E5222Q;34040:" #(#fn(str-length)-oc-extra* getprop *formals-list* filter #fn("n1700A52S:" #(member) 7)+8;B3[07A02B527C2D8<>18;527>02B7E8<8=5253^1^1@30q47F60:" #(#0#
0)
table-clone #fn("n12050212285>1q053485:" #(#fn(table)#fn(table-foldl)
--- a/src/compiler.sl
+++ b/src/compiler.sl
@@ -411,7 +411,7 @@
(let ((lam (car form)))
(and (cons? lam)
(eq? (car lam) 'λ)
- (list? (cadr lam))
+ (proper-list? (cadr lam))
(every sym? (cadr lam))
(not (length> (cadr lam) 255))
(length= (cadr lam) (length (cdr form))))))
--- a/src/system.sl
+++ b/src/system.sl
@@ -483,7 +483,31 @@
(any pred (cdr lst)))))
(def (list? a)
- (or (not a) (and (cons? a) (list? (cdr a)))))
+ "Return `T` if the value is either `NIL` or a cons cell, `NIL`
+ otherwise."
+ (or (not a) (cons? a)))
+
+(def (proper-list? a)
+ "Return `T` is the value is a proper list. That is, a non-circular
+ list with the last element being `NIL`, as opposed to a dotted list.
+
+ Examples:
+
+ (proper-list? NIL) → T
+ (proper-list? '(1)) → T
+ (proper-list? '(1 . 2) → NIL
+ (def l '(1))
+ (set-cdr! l l) → #0=(1 . #0#)
+ (length l) → +inf.0
+ (proper-list? l) → NIL"
+ (def (proper? a b)
+ (let* {[a (cdr a)]+ [b (cdr b)]
+ [b (if (cons? b) (cdr b) b)]}
+ (if (and (cons? a) (cons? b) (not (eq? a b)))
+ (proper? a b)
+ (and (or (not a) (cons? a)) (not b)))))
+ (or (not a) (and (cons? a) (proper? a a))))
(def (list-tail lst n)
(if (<= n 0)
--- a/test/unittest.sl
+++ b/test/unittest.sl
@@ -200,6 +200,23 @@
(assert (equal? 0 (if (and '(1) 1 'x NIL) 2 0)))
(assert (equal? 0 (if (or NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL) 2 0)))
+; proper/dotted/circular list tests
+(assert (not NIL))
+(assert (not (cons? NIL)))
+(assert (not (not '(1))))
+(assert (cons? '(1)))
+(assert (list? '(1)))
+(assert (proper-list? '(1)))
+(assert (list? NIL))
+(assert (proper-list? NIL))
+(assert (list? '(1 . 2)))
+(assert (not (proper-list? '(1 . 2))))
+(def cl '(1 2 3))
+(set-cdr! (cddr cl) cl)
+(assert (cons? cl))
+(assert (list? cl))
+(assert (not (proper-list? cl)))
+
; failing applications
(assert-fail ((λ (x) x) 1 2))
(assert-fail ((λ (x) x)))
@@ -468,8 +485,6 @@
(assert (not (subseq NIL 0)))
(assert (equal? (subseq (apply vec (iota 10)) 10) (vec)))
(assert (equal? (subseq (vec) 0) (vec)))
-(def cl '(1 2 3))
-(set-cdr! (cddr cl) cl)
(assert (equal? (subseq cl 1 8) '(2 3 1 2 3 1 2)))
;; map with different return types