ref: c141adb1002f51f9754b288de7102f7d76dd5373
parent: 5090b2fec4c35cfc5b41fcb32e8efc33a078567f
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Mar 18 22:39:09 EDT 2025
refactor gen.lsp, add more docs; simplify (help ...)
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -12,40 +12,35 @@
#fn("n201m:" #()) NIL #fn("z0700}2:" #(vec)) #fn("z0700}2:" #(aset!)) NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL #fn("n3012082>1|:" #(#fn("n1A061:" #()))) NIL NIL NIL NIL NIL NIL NIL NIL #fn("z0700}2:" #(aref)) NIL NIL NIL)- *properties* #table(*funvars* #table(zero? ((x)) >= ((a . rest)) void? ((x)) identity ((x)) length= ((lst
+ *properties* #table(*funvars* #table(zero? ((x)) bound? ((symbol)) void? ((x)) >= ((a . rest)) identity ((x)) 1+ ((n)) length= ((lst
n)) positive? ((x)) doc-for ((term (doc NIL))) io-eof? ((io)) car ((lst)) <= ((a . rest)) str (term) remprop ((symbol
- key)) negative? ((x)) void (rest) rand (NIL) nan? ((x)) sym (term) file ((path (:read NIL)
- (:write NIL)
- (:create NIL)
- (:truncate
- NIL)
- (:append NIL))) rand-double (NIL) exit ((status)) 1- ((n)) cdr ((lst)) + ((num…)) > ((a . rest)) __finish ((status)) lz-unpack ((data
- :to destination)
- (data :size decompressed-bytes)) io? ((term)) defstruct ((name doc options… (slot-1 DEFAULT)
- slot-2 (slot-3 :read-only))
- (name (:type vec) (:named T) (:constructor
- T)
- (:conc-name NIL) (:predicate NIL) . slots)) eof-object? ((term)) help ((term)) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) buffer (NIL) add-exit-hook ((fun)) /= ((a . rest)) lz-pack ((data
- (level 0))) rand-float (NIL) *prompt* (NIL) cons? ((value)) putprop ((symbol key val)) * ((num…)) vm-stats (NIL) getprop ((symbol
- key (def NIL))) 1+ ((n)) io->str ((io))) *doc* #table(*properties* "All properties of symbols recorded with `putprop` are recorded in this table." >= "Return `T` if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return `T` if `x` is `#<void>`, `NIL` otherwise." zero? "Return `T` if `x` is zero." identity "Return `x`." length= "Perform a bounded length test.\n\nUse this instead of `(= (length lst) 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." io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise." car "Return the first element of a list or `NIL` if not available." *builtins* "VM instructions as closures." str "Convert terms to a concatenated string.\n\nThis is equivalent to `(princ terms…)`, except the string is\nreturned, rather than printed." remprop "Remove a property value associated with a symbol." <= "Return `T` if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." negative? "Return `T` if `x` is negative." rand "Return a random non-negative fixnum on its maximum range." sym "Convert terms to a symbol.\n\nThis is equivalent to `(sym (str terms…))`." nan? "Return `T` if the argument is *NaN*, regardless of the sign." 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." 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]." exit "Terminate the process with the specified status. Does not return." 1- "Equivalent to `(- n 1)`." cdr "Return the tail of a list or `NIL` if not available." + "Return sum of the numbers or `0` with no arguments." T "A boolean \"true\".\n\n(not T) → NIL\n(if T 'yes 'no) → 'yes" > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)." 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." 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." help "Display documentation for the specified term, if available." defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`),\nwhere the first element is the name of the structure's type, the\nrest are the slot values. If the name as the first element isn't\nrequired, `:named NIL` should be used. A list can be used instead\nof a vector by adding `:type list` option.\n\nAn example of a default constructor signature, based on structure\ndefinition:\n\n (defstruct blah a b c) →\n (make-blah (:a NIL) (:b NIL) (:c NIL))\n\nIt can be customized in several ways. For example:\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 `name-`.\n\nD
\ No newline at end of file
+ key)) negative? ((x)) rand (NIL) sym (term) nan? ((x) (v)) void (rest) file ((path (:read
+ NIL)
+ (:write NIL) (:create NIL) (:truncate NIL) (:append NIL))) fixnum? ((v)) rand-double (NIL) exit ((status)) cdr ((lst)) + ((num…)) vec? ((v)) for ((min
+ max fn)) lz-unpack ((data :to destination)
+ (data :size decompressed-bytes)) > ((a . rest)) 1- ((n)) io? ((term)) defstruct ((name
+ doc options… (slot-1 DEFAULT) slot-2 (slot-3 :read-only))
+ (name (:type vec) (:named T) (:constructor T) (:conc-name NIL) (:predicate NIL) . slots)) eof-object? ((term)) help ((term)) __finish ((status)) rand-u32 (NIL) = ((a . rest)
+ (num…)) rand-u64 (NIL) buffer (NIL) compare ((x y)) num? ((v)) /= ((a . rest)) fn? ((v)) add-exit-hook ((fun)) lz-pack ((data
+ (level 0))) rand-float (NIL) *prompt* (NIL) builtin? ((v)) cons? ((value)) vm-stats (NIL) * ((num…)) putprop ((symbol
+ key val)) getprop ((symbol key (def NIL))) aref ((seq subscript…)) io->str ((io))) *doc* #table(io->str "Return an in-memory `io` buffer converted to a string." bound? "Return `T` if `symbol` has a value associated with it, `NIL` otherwise." io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise." sym "Convert terms to a symbol.\n\nThis is equivalent to `(sym (str terms…))`." nan? "Return `T` if `v` is a floating point representation of NaN, either\nnegative or positive, `NIL` otherwise." 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" fixnum? "Return `T` if `v` is of a fixnum type, `NIL` otherwise." exit "Terminate the process with the specified status. Does not return." > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)." + "Return sum of the numbers or `0` with no arguments." __finish "A function called right before exit by the VM." 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." defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`),\nwhere the first element is the name of the structure's type, the\nrest are the slot values. If the name as the first element isn't\nrequired, `:named NIL` should be used. A list can be used instead\nof a vector by adding `:type list` option.\n\nAn example of a default constructor signature, based on structure\ndefinition:\n\n (defstruct blah a b c) →\n (make-blah (:a NIL) (:b NIL) (:c NIL))\n\nIt can be customized in several ways. For example:\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 `name-`.\n\nDefault predicate name (`name?`) can be changed:\n\n ; use \"blargh?\" instead of \"blah?\"\n (defstruct blah :predicate blargh? a b c)" 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\nsingle argument, which is (usually) `0` on success and any other\nnumber on error." rand-float "Return a random float on [0.0, 1.0] interval." builtin? "Return `T` if `v` is a built-in function, `NIL` otherwise." cons? "Return `T` if the value is a cons cell, `NIL` otherwise." 1+ "Equivalent to `(+ n 1)`." aref "Return the sequence element by the subscripts. The sequence can be an\narray, vector or a list.\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 table." zero? "Return `T` if `x` is zero." >= "Return `T` if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return `T` if `x` is `#<void>`, `NIL` otherwise." length= "Perform
\ No newline at end of file
efault predicate name (`name?`) can be changed:\n\n ; use \"blargh?\" instead of \"blah?\"\n (defstruct blah :predicate blargh? a b c)" rand-u32 "Return a random integer on interval [0, 2³²-1]." = "Return `T` if the arguments are equal." rand-u64 "Return a random integer on interval [0, 2⁶⁴-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." NIL "An empty list. Also used as the opposite of T.\n\n(not NIL) → T\n(if NIL 'yes 'no) → 'no\n(car NIL) → NIL\n(cdr NIL) → NIL" 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\nsingle argument, which is (usually) `0` on success and any other\nnumber on error." /= "Return `T` if not all arguments are equal. Shorthand for `(not (= …))`." lz-pack "Return data compressed using Lempel-Ziv.\n\nThe data must be an array, returned value will have the same type.\nThe optional `level` is between `0` and `10`. With `level` set to\n`0` a simple LZSS using hashing will be performed. Levels between\n`1` and `9` offer a trade-off between time/space and ratio. Level\n`10` is optimal but very slow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." cons? "Return `T` if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." getprop "Get a property value associated with a symbol or `def` if missing." 1+ "Equivalent to `(+ n 1)`." io->str "Return an in-memory `io` buffer converted to a string."))
*syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void sym-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings *io-in* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if begin)) defmacro #fn("z170151863D0710<860=5341=?1@30q42223240<e22526e10=e12715153e3e2:" #(value-get-doc-f the list of exit hooks.\n\nOn shutdown each exit hook is called with the exit status as a\nsingle argument, which is (usually) `0` on success and any other\nnumber on error." /= "Return `T` if not all arguments are equal. Shorthand for `(not (= …))`." lz-pack "Return data compressed using Lempel-Ziv.\n\nThe data must be an array, returned value will have the same type.\nThe optional `level` is between `0` and `10`. With `level` set to\n`0` a simple LZSS using hashing will be performed. Levels between\n`1` and `9` offer a trade-off between time/space and ratio. Level\n`10` is optimal but very slow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." cons? "Return `T` if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." getprop "Get a property value associated with a symbol or `def` if missing." 1+ "Equivalent to `(+ n 1)`." io->str "Return an in-memory `io` buffer converted to a string."))
+mprop "Remove a property value associated with a symbol." <= "Return `T` if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." negative? "Return `T` if `x` is negative." 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." 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 tail of a list or `NIL` if not available." T "A boolean \"true\".\n\n(not T) → NIL\n(if T 'yes 'no) → 'yes" vec? "Return `T` if `v` is a vector, `NIL` otherwise." 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." help "Display documentation for the specified term, if available." rand-u32 "Return a random integer on interval [0, 2³²-1]." = "Numerical equality test. Return `T` if all numbers are equal," rand-u64 "Return a random integer on interval [0, 2⁶⁴-1]." NIL "An empty list. Also used as the opposite of T.\n\n(not NIL) → T\n(if NIL 'yes 'no) → 'no\n(car NIL) → NIL\n(cdr NIL) → NIL" /= "Return `T` if not all arguments are equal. Shorthand for `(not (= …))`." fn? "Return `T` if `v` is a function, `NIL` otherwise." lz-pack "Return data compressed using Lempel-Ziv.\n\nThe data must be an array, returned value will have the same type.\nThe optional `level` is between `0` and `10`. With `level` set to\n`0` a simple LZSS using hashing will be performed. Levels between\n`1` and `9` offer a trade-off between time/space and ratio. Level\n`10` is optimal but very slow." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." getprop "Get a property value associated with a symbol or `def` if missing." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." identity "Return `x`."))
ccess and any other\nnumber on error." /= "Return `T` if not all arguments are equal. Shorthand for `(not (= …))`." lz-pack "Return data compressed using Lempel-Ziv.\n\nThe data must be an array, returned value will have the same type.\nThe optional `level` is between `0` and `10`. With `level` set to\n`0` a simple LZSS using hashing will be performed. Levels between\n`1` and `9` offer a trade-off between time/space and ratio. Level\n`10` is optimal but very slow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." cons? "Return `T` if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." getprop "Get a property value associated with a symbol or `def` if missing." 1+ "Equivalent to `(+ n 1)`." io->str "Return an in-memory `io` buffer converted to a string."))
*syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void-ween time/space and ratio. Level\n`10` is optimal but very slow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." cons? "Return `T` if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." getprop "Get a property value associated with a symbol or `def` if missing." 1+ "Equivalent to `(+ n 1)`." io->str "Return an in-memory `io` buffer converted to a string."))
+e, REPL will not print\nit." 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 tail of a list or `NIL` if not available." T "A boolean \"true\".\n\n(not T) → NIL\n(if T 'yes 'no) → 'yes" vec? "Return `T` if `v` is a vector, `NIL` otherwise." 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." help "Display documentation for the specified term, if available." rand-u32 "Return a random integer on interval [0, 2³²-1]." = "Numerical equality test. Return `T` if all numbers are equal," rand-u64 "Return a random integer on interval [0, 2⁶⁴-1]." NIL "An empty list. Also used as the opposite of T.\n\n(not NIL) → T\n(if NIL 'yes 'no) → 'no\n(car NIL) → NIL\n(cdr NIL) → NIL" /= "Return `T` if not all arguments are equal. Shorthand for `(not (= …))`." fn? "Return `T` if `v` is a function, `NIL` otherwise." lz-pack "Return data compressed using Lempel-Ziv.\n\nThe data must be an array, returned value will have the same type.\nThe optional `level` is between `0` and `10`. With `level` set to\n`0` a simple LZSS using hashing will be performed. Levels between\n`1` and `9` offer a trade-off between time/space and ratio. Level\n`10` is optimal but very slow." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." getprop "Get a property value associated with a symbol or `def` if missing." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." identity "Return `x`."))
uctions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." cons? "Return `T` if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." getprop "Get a property value associated with a symbol or `def` if missing." 1+ "Equivalent to `(+ n 1)`." io->str "Return an in-memory `io` buffer converted to a string."))
*syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void sym-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings *io-in* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if begin)) defmacro #fn("z170151863D0710<860=5341=?1@30q42223240<e22526e10=e12715153e3e2:" #(value-get-doc-e:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void- sym-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings- *io-in* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if- begin)) defmacro #fn("z170151863D0710<860=5341=?1@30q42223240<e22526e10=e12715153e3e2:" #(value-get-doc+-u32 "Return a random integer on interval [0, 2³²-1]." = "Numerical equality test. Return `T` if all numbers are equal," rand-u64 "Return a random integer on interval [0, 2⁶⁴-1]." NIL "An empty list. Also used as the opposite of T.\n\n(not NIL) → T\n(if NIL 'yes 'no) → 'no\n(car NIL) → NIL\n(cdr NIL) → NIL" /= "Return `T` if not all arguments are equal. Shorthand for `(not (= …))`." fn? "Return `T` if `v` is a function, `NIL` otherwise." lz-pack "Return data compressed using Lempel-Ziv.\n\nThe data must be an array, returned value will have the same type.\nThe optional `level` is between `0` and `10`. With `level` set to\n`0` a simple LZSS using hashing will be performed. Levels between\n`1` and `9` offer a trade-off between time/space and ratio. Level\n`10` is optimal but very slow." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\n\nDefault function prints `#;> `." getprop "Get a property value associated with a symbol or `def` if missing." vm-stats "Print various VM-related information, such as the number of GC\ncalls so far, heap and stack size, etc." * "Return product of the numbers or `1` with no arguments." putprop "Associate a property value with a symbol." identity "Return `x`."))
+ *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void+ sym-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings dr caadr let if cddr #:g20) cond-clauses->if))) do #fn("z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map) car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g351 λ if #fn(nconc) begin #fn(copy-list))) mark-label #fn("n22002122e21e4:" #(emit quote label)) with-bindings #fn("z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map)@@ -58,7 +53,7 @@
ef)) > #fn("z12021e12273151510e163:" #(#fn(nconc) < #fn(copy-list) reverse!)) when #fn("z1200211Pqe4:" #(if begin)) quasiquote #fn("n1700E62:" #(bq-process)) help #fn("n1700215285;3;042285235270024q5387;3>0487<B;350487863q07586<51486=3Q0262786=52478504883907850@30q@30q488360q@607850@30q4883e086=360q@;07850478504752951478504262:0>1885247850@30q486;J50488360q@>0752;0524785047<60:" #(getprop*doc* #fn(str-split) "\n" *funvars* princ #fn(for-each)
-524785047<60:" #(getprop
+z0Ib520852185>1_51485<061:" #(#0=#fn("z0I:" #() void)e
princ " " print)) "no help for " void)) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5142586<51;360486<8=;360486=;J50486268>5127288>528<8>512912:5285;J:042902:5283;3\\0483H;3M0483DQ;3:04292;052;J504838AP;J5048382;36040e184;J:042<02=522>2?e12@8C2Ae22B8B2Ae22C2D2E8Ee2e22F2G2AEe32E0e2e3e32H2I2Ae2268E518?Me3e4e3e12J8=2K2E0e28=e3e3e18D3X02@8D2>1e12>2Ee12L8E5152e12L8@5153e3@30qe12L7M2N8;8A8@8F8C8E0>78?525165:" #(#(NILNIL :named 1 :conc-name 3 :type 0 NIL NIL NIL NIL NIL NIL :predicate 4 NIL NIL NIL NIL NIL NIL
@@ -67,7 +62,7 @@
28552485:" #(cddr #fn(for-each)
#fn("n17002152340q:722324A<25F2605661:" #(member(:read-only) error #fn(str) "invalid option in slot " " of struct " ": "))) slot-opts)
-3=071228652@30q423242586522087<51390q87P@408762:" #(#fn(keyword?)
+#fn("n1200Ee3:" #(aref)) make-label #fn("n120e1:" #(gensym)) bcode:cenv #fn("n1200r3e3:" #(aref)) > #fn("z12021e12273151510e163:" #(#fn(nconc)st*) #fn(sym) #\:))) tokw)
#fn(str?) #fn(length) #fn(map) #fn("n10B3500<:0:" #())#fn(sym) #\? "make-" #fn(str) "-" #fn(nconc) begin def s and or not quote eq? aref = length when
@@ -451,7 +446,7 @@
#fn(str-length)
#fn(str-sub)) str-trim)
sym-set-doc #fn("z220Z3\x9f013\x9b0211225287<87=732489528:;3H04258:5125768:27285351~8:;3?04292:8;>1895270888<P22527;02<8=53^1^1^1^1^1^1^1@30q482B3\\07=02>q537?2@87>182527;02>2A87885253^1^1@30q47B60:" #(str-join-^1^1@30q482B3\\07=02>q537?2@87>182527;02>2A87885253^1^1@30q47B60:" #(str-join
+ str-map #fn("n2205021151EI8887L23O0422860231885251524748851?8@\f/^14258661:" #(#fn(buffer) "\n" any #fn("n1E20051L2;3@040EG21l2;34040:" #(#fn(length) #\space)) #fn(length) str-trim " " "" #fn(map) #fn("n170A2105152390220A62:0:" #(<= #fn(length)#fn(str-sub))) putprop
--- a/src/opcodes.c
+++ b/src/opcodes.c
@@ -1,38 +1,38 @@
#include "sl.h"
const Builtin builtins[N_OPCODES] = {- [OP_NANP] = {"nan?", 1},- [OP_SETCAR] = {"set-car!", 2},- [OP_VECP] = {"vec?", 1},- [OP_CDR] = {"cdr", 1},- [OP_FNP] = {"fn?", 1},- [OP_CADR] = {"cadr", 1},- [OP_SETCDR] = {"set-cdr!", 2},- [OP_EQ] = {"eq?", 2},- [OP_APPLY] = {"apply", -2},- [OP_ASET] = {"aset!", -3},- [OP_CONSP] = {"cons?", 1},- [OP_ATOMP] = {"atom?", 1},- [OP_NOT] = {"not", 1},- [OP_LIST] = {"list", ANYARGS},- [OP_NUMP] = {"num?", 1},- [OP_CONS] = {"cons", 2},- [OP_BOUNDP] = {"bound?", 1},- [OP_LT] = {"<", -1},- [OP_CAR] = {"car", 1},- [OP_EQV] = {"eqv?", 2},- [OP_IDIV] = {"div0", 2},- [OP_FIXNUMP] = {"fixnum?", 1},- [OP_NUMEQ] = {"=", -1}, [OP_BUILTINP] = {"builtin?", 1},+ [OP_FIXNUMP] = {"fixnum?", 1},+ [OP_COMPARE] = {"compare", 2}, [OP_SUB] = {"-", -1},+ [OP_LT] = {"<", -1},+ [OP_BOUNDP] = {"bound?", 1},+ [OP_CAR] = {"car", 1}, [OP_VEC] = {"vec", ANYARGS},- [OP_COMPARE] = {"compare", 2},+ [OP_DIV0] = {"div0", 2},+ [OP_EQUALP] = {"equal?", 2},+ [OP_DIV] = {"/", -1},+ [OP_SYMP] = {"sym?", 1}, [OP_FOR] = {"for", 3},- [OP_MUL] = {"*", ANYARGS}, [OP_ADD] = {"+", ANYARGS}, [OP_AREF] = {"aref", -2},- [OP_DIV] = {"/", -1},- [OP_EQUAL] = {"equal?", 2},- [OP_SYMP] = {"sym?", 1},+ [OP_MUL] = {"*", ANYARGS},+ [OP_VECP] = {"vec?", 1},+ [OP_CDR] = {"cdr", 1},+ [OP_NUMEQP] = {"=", -1},+ [OP_NANP] = {"nan?", 1},+ [OP_EQP] = {"eq?", 2},+ [OP_ATOMP] = {"atom?", 1},+ [OP_SETCAR] = {"set-car!", 2},+ [OP_ASET] = {"aset!", -3},+ [OP_CONSP] = {"cons?", 1},+ [OP_CONS] = {"cons", 2},+ [OP_NOT] = {"not", 1},+ [OP_NUMP] = {"num?", 1},+ [OP_EQVP] = {"eqv?", 2},+ [OP_LIST] = {"list", ANYARGS},+ [OP_FNP] = {"fn?", 1},+ [OP_CADR] = {"cadr", 1},+ [OP_SETCDR] = {"set-cdr!", 2},+ [OP_APPLY] = {"apply", -2},};
--- a/src/opcodes.h
+++ b/src/opcodes.h
@@ -32,7 +32,7 @@
OP_SETCDR,
OP_KEYARGS,
OP_CONS,
- OP_EQ,
+ OP_EQP,
OP_SYMP,
OP_NOT,
OP_CADR,
@@ -50,8 +50,8 @@
OP_JMPL,
OP_BRNL,
OP_BOX,
- OP_EQV,
- OP_EQUAL,
+ OP_EQVP,
+ OP_EQUALP,
OP_LIST,
OP_APPLY,
OP_ADD,
@@ -58,8 +58,8 @@
OP_SUB,
OP_MUL,
OP_DIV,
- OP_IDIV,
- OP_NUMEQ,
+ OP_DIV0,
+ OP_NUMEQP,
OP_COMPARE,
OP_ARGC,
OP_VEC,
@@ -87,7 +87,7 @@
OP_AREF,
OP_BOXL,
OP_OPTARGS,
- OP_EOF_OBJECT,
+ OP_DUMMY_EOF,
N_OPCODES
}sl_op;
--- a/src/sl.h
+++ b/src/sl.h
@@ -348,7 +348,7 @@
sl_nil = builtin(OP_LOADNIL),
sl_t = builtin(OP_LOADT),
sl_void = builtin(OP_LOADVOID),
- sl_eof = builtin(OP_EOF_OBJECT),
+ sl_eof = builtin(OP_DUMMY_EOF),
};
enum {--- a/src/system.lsp
+++ b/src/system.lsp
@@ -163,29 +163,17 @@
(defmacro (help term)
"Display documentation for the specified term, if available."
(let* {[doc (getprop term '*doc*)]- [lines (and doc (str-split doc "\n"))]
[funvars (getprop term '*funvars* nil)]
[fvs (and funvars (cons? (car funvars)) funvars)]}
- (when lines
- (princ (car lines))
- (if (cdr lines)
- (begin (for-each (λ (line) (newline) (princ line))
- (cdr lines))
- (newline)
- (when fvs
- (newline))))
- (unless fvs
- (newline)))
(when fvs
- (unless (cdr lines)
- (newline)
- (newline))
- (princ "Signature:")
- (newline)
- (for-each (λ (fv) (newline) (princ " ") (print (cons term fv)))
+ (for-each (λ (fv) (print (cons term fv))
+ (newline))
fvs)
(newline))
- (unless (or lines fvs)
+ (when doc
+ (princ doc)
+ (newline))
+ (unless (or doc fvs)
(princ "no help for " term)
(newline))
(void)))
--- a/src/vm.h
+++ b/src/vm.h
@@ -76,7 +76,7 @@
case OP_AREF: goto LABEL(apply_aref);
case OP_ASET: goto LABEL(apply_aset);
case OP_LT: goto LABEL(apply_lt);
- case OP_NUMEQ: goto LABEL(apply_numeq);
+ case OP_NUMEQP: goto LABEL(apply_numeqp);
default:
#if defined(COMPUTED_GOTO)
goto *ops[i];
@@ -573,7 +573,7 @@
NEXT_OP;
}
-OP(OP_EQUAL) {+OP(OP_EQUALP) {sl_v a = sp[-2], b = sp[-1];
sp--;
sp[-1] = (a == b || sl_compare(a, b, true) == 0) ? sl_t : sl_nil;
@@ -640,7 +640,7 @@
NEXT_OP;
}
-OP(OP_EQ)
+OP(OP_EQP)
sp[-2] = sp[-2] == sp[-1] ? sl_t : sl_nil;
sp--;
NEXT_OP;
@@ -662,9 +662,9 @@
NEXT_OP;
}
-OP(OP_NUMEQ) {+OP(OP_NUMEQP) {n = *ip++;
-LABEL(apply_numeq):;
+LABEL(apply_numeqp):;
int i = n;
sl_v a = sp[-i], b, v;
for(v = sl_t; i > 1; a = b){@@ -761,7 +761,7 @@
NEXT_OP;
}
-OP(OP_IDIV) {+OP(OP_DIV0) {sl_v a = sp[-2];
sl_v b = sp[-1];
if(sl_unlikely(b == 0)){@@ -885,7 +885,7 @@
ip += 4;
NEXT_OP;
-OP(OP_EQV) {+OP(OP_EQVP) {sl_v a = sp[-2], b = sp[-1];
sp[-2] = (a == b || (leafp(a) && leafp(b) && sl_compare(a, b, true) == 0)) ? sl_t : sl_nil;
sp--;
--- a/tools/gen.lsp
+++ b/tools/gen.lsp
@@ -1,173 +1,250 @@
+(defstruct op name cname nargs closure docs)
-(def opcodes '(
- ; C opcode, lisp compiler opcode, arg count, builtin lambda, DOC (NEW)
- OP_LOADA0 loada0 nil nil nil
- OP_LOADA1 loada1 nil nil nil
- OP_LOADV loadv nil nil nil
- OP_BRN brn nil nil nil
- OP_POP pop nil nil nil
- OP_CALL call nil nil nil
- OP_TCALL tcall nil nil nil
- OP_LOADG loadg nil nil nil
- OP_LOADA loada nil nil nil
- OP_LOADC loadc nil nil nil
- OP_RET ret nil nil nil
- OP_DUP dup nil nil nil
- OP_CAR car 1 (λ (x) (car x)) (
- ((lst) "Return the first element of a list or `NIL` if not available."))
- OP_CDR cdr 1 (λ (x) (cdr x)) (
- ((lst) "Return the tail of a list or `NIL` if not available."))
- OP_CLOSURE closure nil nil nil
- OP_SETA seta nil nil nil
- OP_JMP jmp nil nil nil
- OP_LOADC0 loadc0 nil nil nil
- OP_CONSP cons? 1 (λ (x) (cons? x)) (
- ((value) "Return `T` if the value is a cons cell."))
- OP_BRNE brne nil nil nil
- OP_LOADT loadt nil nil nil
- OP_LOAD0 load0 nil nil nil
- OP_LOADC1 loadc1 nil nil nil
- OP_AREF2 aref2 nil nil nil
- OP_ATOMP atom? 1 (λ (x) (atom? x)) nil
- OP_LOADVOID loadvoid nil nil nil
- OP_BRNN brnn nil nil nil
- OP_LOAD1 load1 nil nil nil
- OP_LT < -1 (λ rest (apply < rest)) nil
- OP_ADD2 add2 nil nil nil
- OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y)) nil
- OP_KEYARGS keyargs nil nil nil
- OP_CONS cons 2 (λ (x y) (cons x y)) nil
- OP_EQ eq? 2 (λ (x y) (eq? x y)) nil
- OP_SYMP sym? 1 (λ (x) (sym? x)) nil
- OP_NOT not 1 (λ (x) (not x)) nil
- OP_CADR cadr 1 (λ (x) (cadr x)) nil
- OP_NEG neg nil nil nil
- OP_NANP nan? 1 (λ (x) (nan? x)) nil
- OP_BRBOUND brbound nil nil nil
- OP_NUMP num? 1 (λ (x) (num? x)) nil
- OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x)) nil
- OP_BOUNDP bound? 1 (λ (x) (bound? x)) nil
- OP_BUILTINP builtin? 1 (λ (x) (builtin? x)) nil
- OP_FNP fn? 1 (λ (x) (fn? x)) nil
- OP_VECP vec? 1 (λ (x) (vec? x)) nil
- OP_SHIFT shift nil nil nil
- OP_SETCAR set-car! 2 (λ (x y) (set-car! x y)) nil
- OP_JMPL jmp.l nil nil nil
- OP_BRNL brn.l nil nil nil
- OP_BOX box nil nil nil
- OP_EQV eqv? 2 (λ (x y) (eqv? x y)) nil
- OP_EQUAL equal? 2 (λ (x y) (equal? x y)) nil
- OP_LIST list ANYARGS (λ rest rest) nil
- OP_APPLY apply -2 (λ rest (apply apply rest)) nil
- OP_ADD + ANYARGS (λ rest (apply + rest)) (
- ((num…) "Return sum of the numbers or `0` with no arguments."))
- OP_SUB - -1 (λ rest (apply - rest)) nil
- OP_MUL * ANYARGS (λ rest (apply * rest)) (
- ((num…) "Return product of the numbers or `1` with no arguments."))
- OP_DIV / -1 (λ rest (apply / rest)) nil
- OP_IDIV div0 2 (λ rest (apply div0 rest)) nil
- OP_NUMEQ = -1 (λ rest (apply = rest)) nil
- OP_COMPARE compare 2 (λ (x y) (compare x y)) nil
- OP_ARGC argc nil nil nil
- OP_VEC vec ANYARGS (λ rest (apply vec rest)) nil
- OP_ASET aset! -3 (λ rest (apply aset! rest)) nil
- OP_LOADNIL loadnil nil nil nil
- OP_LOADI8 loadi8 nil nil nil
- OP_LOADVL loadv.l nil nil nil
- OP_LOADGL loadg.l nil nil nil
- OP_LOADAL loada.l nil nil nil
- OP_LOADCL loadc.l nil nil nil
- OP_SETG setg nil nil nil
- OP_SETGL setg.l nil nil nil
- OP_SETAL seta.l nil nil nil
- OP_VARGC vargc nil nil nil
- OP_TRYCATCH trycatch nil nil nil
- OP_FOR for 3 (λ (a b f) (for a b (λ (x) (f x)))) nil
- OP_TAPPLY tapply nil nil nil
- OP_SUB2 sub2 nil nil nil
- OP_ARGCL argc.l nil nil nil
- OP_VARGCL vargc.l nil nil nil
- OP_CALLL call.l nil nil nil
- OP_TCALLL tcall.l nil nil nil
- OP_BRNEL brne.l nil nil nil
- OP_BRNNL brnn.l nil nil nil
- OP_AREF aref -2 (λ rest (apply aref rest)) nil
- OP_BOXL box.l nil nil nil
- OP_OPTARGS optargs nil nil nil
- OP_EOF_OBJECT dummy_eof nil nil nil
+(def (rune-alphanumeric? r)
+ (or (rune-alphabetic? r)
+ (rune-numeric? r)))
+
+(def (name->cname name)
+ (let {[cname (buffer)]}+ (for 0 (1- (length name))
+ (λ (i) (let {[r (rune (aref name i))]}+ (io-write cname
+ (cond [(rune-alphanumeric? r) (rune-upcase r)]
+ [(= r #\?) #\P]
+ [(= r #\_) #\_]
+ [else ""])))))
+ (io->str cname)))
+
+(defmacro (op symbol (nargs NIL) (closure NIL) (docs NIL) (:cname NIL))
+ (let ((name (str symbol)))
+ `(make-op :name ,name
+ :cname ,(str "OP_" (or cname (name->cname name)))
+ :nargs ,nargs
+ :closure ',closure
+ :docs ,docs)))
+
+(def ops (vec
+ (op loada0)
+ (op loada1)
+ (op loadv)
+ (op brn)
+ (op pop)
+ (op call)
+ (op tcall)
+ (op loadg)
+ (op loada)
+ (op loadc)
+ (op ret)
+ (op dup)
+ (op car 1 (λ (x) (car x))
+ '{[(lst)+ "Return the first element of a list or `NIL` if not available."]})
+ (op cdr 1 (λ (x) (cdr x))
+ '{[(lst)+ "Return the tail of a list or `NIL` if not available."]})
+ (op closure)
+ (op seta)
+ (op jmp)
+ (op loadc0)
+ (op cons? 1 (λ (x) (cons? x))
+ '{[(value)+ "Return `T` if the value is a cons cell, `NIL` otherwise."]})
+ (op brne)
+ (op loadt)
+ (op load0)
+ (op loadc1)
+ (op aref2)
+ (op atom? 1 (λ (x) (atom? x)))
+ (op loadvoid)
+ (op brnn)
+ (op load1)
+ (op < -1 (λ rest (apply < rest))
+ :cname "LT")
+ (op add2)
+ (op set-cdr! 2 (λ (x y) (set-cdr! x y)))
+ (op keyargs)
+ (op cons 2 (λ (x y) (cons x y)))
+ (op eq? 2 (λ (x y) (eq? x y)))
+ (op sym? 1 (λ (x) (sym? x)))
+ (op not 1 (λ (x) (not x)))
+ (op cadr 1 (λ (x) (cadr x)))
+ (op neg)
+ (op nan? 1 (λ (x) (nan? x))
+ '{[(v)+ "Return `T` if `v` is a floating point representation of NaN, either
+ negative or positive, `NIL` otherwise."]})
+ (op brbound)
+ (op num? 1 (λ (x) (num? x))
+ '{[(v)+ "Return `T` if `v` is of a numerical type, `NIL` otherwise.
+
+ Numerical types include floating point, fixnum, bignum, etc.
+ Note: ironically, a NaN value is considered a number by this function
+ since it's only testing the _type_ of the value."]})
+ (op fixnum? 1 (λ (x) (fixnum? x))
+ '{[(v)+ "Return `T` if `v` is of a fixnum type, `NIL` otherwise."]})
+ (op bound? 1 (λ (x) (bound? x))
+ '{[(symbol)+ "Return `T` if `symbol` has a value associated with it, `NIL` otherwise."]})
+ (op builtin? 1 (λ (x) (builtin? x))
+ '{[(v)+ "Return `T` if `v` is a built-in function, `NIL` otherwise."]})
+ (op fn? 1 (λ (x) (fn? x))
+ '{[(v)+ "Return `T` if `v` is a function, `NIL` otherwise."]})
+ (op vec? 1 (λ (x) (vec? x))
+ '{[(v)+ "Return `T` if `v` is a vector, `NIL` otherwise."]})
+ (op shift)
+ (op set-car! 2 (λ (x y) (set-car! x y)))
+ (op jmp.l)
+ (op brn.l)
+ (op box)
+ (op eqv? 2 (λ (x y) (eqv? x y)))
+ (op equal? 2 (λ (x y) (equal? x y)))
+ (op list T (λ rest rest))
+ (op apply -2 (λ rest (apply apply rest)))
+ (op + T (λ rest (apply + rest))
+ '{[(num…)+ "Return sum of the numbers or `0` with no arguments."]}
+ :cname "ADD")
+ (op - -1 (λ rest (apply - rest))
+ :cname "SUB")
+ (op * T (λ rest (apply * rest))
+ '{[(num…)+ "Return product of the numbers or `1` with no arguments."]}
+ :cname "MUL")
+ (op / -1 (λ rest (apply / rest))
+ :cname "DIV")
+ (op div0 2 (λ rest (apply div0 rest)))
+ (op = -1 (λ rest (apply = rest))
+ '{[(num…)+ "Numerical equality test. Return `T` if all numbers are equal,
+ `NIL` otherwise."]}
+ :cname "NUMEQP")
+ (op compare 2 (λ (x y) (compare x y))
+ '{[(x y)+ "Return -1 if `x` is less than `y`, 0 if equal, and `1` if `y` is
+ greater than `x`.
+
+ Examples:
+
+ (compare 'a 'b) → -1
+ (compare 1 1) → 0
+ (compare \"b\" \"a\") → 1"]})
+ (op argc)
+ (op vec T (λ rest (apply vec rest)))
+ (op aset! -3 (λ rest (apply aset! rest)))
+ (op loadnil)
+ (op loadi8)
+ (op loadv.l)
+ (op loadg.l)
+ (op loada.l)
+ (op loadc.l)
+ (op setg)
+ (op setg.l)
+ (op seta.l)
+ (op vargc)
+ (op trycatch)
+ (op for 3 (λ (a b f) (for a b (λ (x) (f x))))
+ '{[(min max fn)+ "Call the function `fn` with a single integer argument, starting from
+ `min` and ending with `max`.
+
+ Examples:
+
+ (for 0 2 (λ (i) (print (- 2 i)))) → 210"]})
+ (op tapply)
+ (op sub2)
+ (op argc.l)
+ (op vargc.l)
+ (op call.l)
+ (op tcall.l)
+ (op brne.l)
+ (op brnn.l)
+ (op aref -2 (λ rest (apply aref rest))
+ '{[(seq subscript…)+ "Return the sequence element by the subscripts. The sequence can be an
+ array, vector or a list.
+
+ Examples:
+
+ (def a '((1 (2 (3)) 4)))
+ (aref a 0) → (1 (2 (3)) 4)
+ (aref a 1) → index 1 out of bounds
+ (aref a 0 0) → 1
+ (aref a 0 1 0) → 2
+ (aref a 0 2) → 4"]})
+ (op box.l)
+ (op optargs)
+ (op dummy_eof)
))
-(def (for-each-n f lst n)
- (when (and (> n 0) (cons? lst))
- (apply f (list-head lst n))
- (for-each-n f (list-tail lst n) n)))
+(def (new path)
+ (file path :write :create :truncate))
-(let ((c-header (file "opcodes.h" :write :create :truncate))
- (c-code (file "opcodes.c" :write :create :truncate))
- (instructions (file "instructions.lsp" :write :create :truncate))
- (builtins (file "builtins.lsp" :write :create :truncate))
- (builtins-doc (file "docs_ops.lsp" :write :create :truncate))
- (e (table))
- (cl (table))
- (ac (table))
- (lms ())
+(let ((c-header (new "opcodes.h"))
+ (c-code (new "opcodes.c"))
+ (instructions (new "instructions.lsp"))
+ (builtins (new "builtins.lsp"))
+ (docs-ops (new "docs_ops.lsp"))
+ (op-to-byte (table))
+ (c-op-to-op-arg (table))
+ (op-to-argc (table))
+ (op-to-closure ())
(i 0))
- (begin
- (io-write c-header "typedef enum {\n")- (for-each-n
- (λ (cop lop argc f docs)
- (begin
- (io-write c-header "\t")
- (write cop c-header)
- (io-write c-header ",\n")
- (for-each (λ (doc)
- (let ((docform (append `(,lop) (car doc))))
- (write (append `(doc-for ,docform)
- (list (cadr doc)))
- builtins-doc)
- (io-write builtins-doc "\n")))
- docs)
- (put! e lop (byte i))
- (when argc
- (put! cl cop (list lop argc))
- (when (and (num? argc) (>= argc 0))
- (put! ac lop argc)))
- (set! lms (cons f lms))
- (set! i (1+ i))))
- opcodes 5)
- (io-close builtins-doc)
- (io-write c-header "\tN_OPCODES\n}sl_op;\n\n")
- (io-write c-header "extern const Builtin builtins[N_OPCODES];\n")
- (io-close c-header)
- (io-write c-code "#include \"sl.h\"\n\n")
- (io-write c-code "const Builtin builtins[N_OPCODES] = {\n")- (for-each
- (λ (c la) (begin (io-write c-code "\t[")
- (write c c-code)
- (io-write c-code "] = {\"")- (write (car la) c-code)
- (io-write c-code "\", ")
- (write (cadr la) c-code)
- (io-write c-code "},\n")))
- cl)
- (io-write c-code "};\n")
- (io-close c-code)
+ (io-write c-header "typedef enum {\n")+ (for-each
+ (λ (op)
+ (let {[lop (sym (op-name op))]+ [argc (op-nargs op)]}
+ (io-write c-header (str "\t" (op-cname op) ",\n"))
+ (for-each (λ (doc)
+ (write `(doc-for ,(cons lop (car doc)) ,(cadr doc))
+ docs-ops)
+ (io-write docs-ops "\n"))
+ (op-docs op))
+ (put! op-to-byte lop (byte i))
+ (when argc
+ (put! c-op-to-op-arg (op-cname op) (list lop (if (eq? argc T) 'ANYARGS argc)))
+ (when (and (num? argc) (>= argc 0))
+ (put! op-to-argc lop argc)))
+ (set! op-to-closure (cons (op-closure op) op-to-closure))
+ (set! i (1+ i))))
+ ops)
+ (io-close docs-ops)
+ (io-write c-header "\tN_OPCODES\n}sl_op;\n\n")
+ (io-write c-header "extern const Builtin builtins[N_OPCODES];\n")
+ (io-close c-header)
+ (io-write c-code "#include \"sl.h\"\n\n")
+ (io-write c-code "const Builtin builtins[N_OPCODES] = {\n")+ (for-each
+ (λ (c la) (begin (io-write c-code (str "\t[" c))
+ (io-write c-code "] = {\"")+ (write (car la) c-code)
+ (io-write c-code "\", ")
+ (write (cadr la) c-code)
+ (io-write c-code "},\n")))
+ c-op-to-op-arg)
+ (io-write c-code "};\n")
+ (io-close c-code)
- (write `(def Instructions
- "VM instructions mapped to their encoded byte representation."
- ,e)
- instructions)
- (io-write instructions "\n\n")
- (write `(def arg-counts
- "VM instructions mapped to their expected arguments count."
- ,ac)
- instructions)
- (io-write instructions "\n")
- (io-close instructions)
- (set! lms (cons vec (reverse! lms)))
- (write `(def *builtins*
- "VM instructions as closures."
- ,lms)
- builtins)
- (io-write builtins "\n")
- (io-close builtins)))
+ (write `(def Instructions
+ "VM instructions mapped to their encoded byte representation."
+ ,op-to-byte)
+ instructions)
+ (io-write instructions "\n\n")
+ (write `(def arg-counts
+ "VM instructions mapped to their expected arguments count."
+ ,op-to-argc)
+ instructions)
+ (io-write instructions "\n")
+ (io-close instructions)
+ (set! op-to-closure (cons vec (reverse! op-to-closure)))
+ (write `(def *builtins*
+ "VM instructions as closures."
+ ,op-to-closure)
+ builtins)
+ (io-write builtins "\n")
+ (io-close builtins))