ref: 47451dfe7e1fdecc6266f63e07ceeaa29040e114
parent: d87fa0118280aed3abcb02722a97283c9a881722
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Mar 19 23:56:47 EDT 2025
document all builtins except eq?, eqv? and equal? Make gen.lsp not rewrite opcodes.[ch] files on error - write to an in-memory buffer first, then copy.
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -12,22 +12,23 @@
#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)) 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) < ((a . rest)) remprop ((symbol
- key)) negative? ((x)) rand (NIL) sym (term) nan? ((v)) void (rest) file ((path (:read NIL)
- (:write NIL)
- (:create NIL)
- (:truncate
- NIL)
- (:append NIL))) fixnum? ((v)) rand-double (NIL) exit ((status)) cdr ((lst)) + (rest) vec? ((v)) for ((min
- max fn)) lz-unpack ((data :to destination)
- (data :size decompressed-bytes)) > ((a . rest)) 1- ((n)) 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)) io? ((term)) help ((term
- (:print-header help-print-header))) __finish ((status)) rand-u32 (NIL) buffer (NIL) rand-u64 (NIL) = ((a . rest)) compare ((x
- y)) num? ((v)) /= ((a . rest)) fn? ((v)) help-print-header ((term sigs)) lz-pack ((data (level
- 0))) rand-float (NIL) *prompt* (NIL) builtin? ((v)) add-exit-hook ((fun)) cons? ((value)) vm-stats (NIL) * (rest) putprop ((symbol
- key val)) getprop ((symbol key (def NIL))) aref ((seq subscript0 . rest)) 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." < "Return `T` if the arguments are in strictly increasing order (next\none is greater than the previous one)." 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 specified by the subscripts. The sequence\n be an array, vector, a list. Multi-dimensional sequences\nvariating 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 table." zero? "Return `T` if `x` is zero." >=
\ No newline at end of file
+ *properties* #table(*funvars* #table(identity ((x)) bound? ((symbol)) io-eof? ((io)) < ((a . rest)) cadr ((cell)) sym (term) nan? ((v)) for ((min
+ max fn)) fixnum? ((v)) exit ((status)) > ((a . rest)) + (rest) div0 ((a b)) __finish ((status)) lz-unpack ((data
+ :to destination)
+ (data :size decompressed-bytes)) 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)) compare ((x y)) buffer (NIL) num? ((v)) add-exit-hook ((fun)) rand-float (NIL) builtin? ((v)) set-car! ((cell
+ new-first)) cons? ((v)) 1+ ((n)) aref ((sequence subscript0 . rest)) zero? ((x)) vec (rest) >= ((a . rest)) sym? ((v)) void? ((x)) length= ((lst
+ n)) positive? ((x)) doc-for ((term (doc NIL))) 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)) apply ((fn
+ arg . rest)) io? ((term)) eof-object? ((term)) list (rest) help ((term (:print-header
+ help-print-header))) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) not ((v)) set-cdr! ((cell
+ new-second)) /= ((a . rest)) fn? ((v)) help-print-header ((term sigs)) lz-pack ((data (level
+ 0))) *prompt* (NIL) 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." io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise." < "Return `T` if the arguments are in strictly increasing order (next\none is greater than the previous one)." 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 "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 arguments or `0` with none." 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" __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." 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)" cons? "Return `T` if `v` is a c
\ No newline at end of file
"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 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." 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." 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\nExamples:\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\nExamples:\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." help-print-header "Format and print term's signature(s) for `(help term)` output." 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--- a/tools/gen.lsp
+++ b/tools/gen.lsp
@@ -38,23 +38,42 @@
(op dup)
(op car 1 (λ (x) (car x))
{[(lst)- "Return the first element of a list or `NIL` if not available."]})
+ "Return the first element of a cons cell (head of a list) or `NIL` if
+ not available.
+
+ Examples:
+
+ (car NIL) → NIL
+ (car '(1 2 3)) → 1
+ (car '(1 . 2)) → 1"]})
(op cdr 1 (λ (x) (cdr x))
{[(lst)- "Return the tail of a list or `NIL` if not available."]})
+ "Return the second element of a cons cell (tail of a list) or `NIL` if
+ not available.
+
+ Examples:
+
+ (cdr NIL) → NIL
+ (cdr '(1 2 3)) → (2 3)
+ (cdr '(1 . 2)) → 2"]})
(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."]})
+ {[(v)+ "Return `T` if `v` is a cons cell, `NIL` otherwise."]})
(op brne)
(op loadt)
(op load0)
(op loadc1)
(op aref2)
- (op atom? 1 (λ (x) (atom? x)))
+ (op atom? 1 (λ (x) (atom? x))
+ {[(value)+ "Return `T` if `v` is a _not_ a cons cell, `NIL` otherwise. This is
+ the opposite of `cons?`.
+
+ The term \"atom\" comes from the idea of being indivisible."]})
(op loadvoid)
(op brnn)
(op load1)
@@ -64,13 +83,44 @@
one is greater than the previous one)."]}
:cname "LT")
(op add2)
- (op set-cdr! 2 (λ (x y) (set-cdr! x y)))
+ (op set-cdr! 2 (λ (x y) (set-cdr! x y))
+ {[(cell new-second)+ "Modify a cons cell (a list) in-place by putting `new-second` as its
+ second element (tail of the list). Return the modified cons
+ cell (list).
+
+ Examples:
+
+ (def q '(1 2 3 4 5))
+ (set-cdr! q '(6 7)) → (1 6 7)
+ q → (1 6 7)"]})
(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 cons 2 (λ (x y) (cons x y))
+ {[(first second)+ "Return a cons cell containing two arguments.
+
+ Examples:
+
+ (cons 1 2) → (1 . 2)
+ (cons 1 '(2)) → (1 2)
+ (cons 1 (cons 2 (cons 3 NIL))) → (1 2 3)"]})
+ (op eq? 2 (λ (x y) (eq? x y))) ; FIXME
+ (op sym? 1 (λ (x) (sym? x))
+ {[(v)+ "Return `T` if `v` is a symbol, `NIL` otherwise."]})
+ (op not 1 (λ (x) (not x))
+ {[(v)+ "Return `T` if `v` is `NIL`, `T` otherwise."]})
+ (op cadr 1 (λ (x) (cadr x))
+ {[(cell)+ "Shorthand for `(car (cdr cell))`, that is, \"first element of the
+ second element\".
+
+ Examples:
+
+ (cadr '(1 2 3)) → 2
+ (cadr '(1)) → NIL
+ (cadr NIL) → NIL"]})
(op neg)
(op nan? 1 (λ (x) (nan? x))
{[(v)@@ -100,32 +150,89 @@
{[(v)"Return `T` if `v` is a vector, `NIL` otherwise."]})
(op shift)
- (op set-car! 2 (λ (x y) (set-car! x y)))
+ (op set-car! 2 (λ (x y) (set-car! x y))
+ {[(cell new-first)+ "Modify a cons cell (a list) in-place by putting `new-first` as its
+ first element (head of the list). Return the modified cons
+ cell (list).
+
+ Examples:
+
+ (def q '(1 2 3 4 5))
+ (set-car! q 0) → (0 6 7)
+ q → (0 6 7)"]})
(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 eqv? 2 (λ (x y) (eqv? x y))) ; FIXME
+ (op equal? 2 (λ (x y) (equal? x y))) ; FIXME
+ (op list T (λ rest rest)
+ {[rest+ "Return a list constructed of the arguments.
+
+ Examples:
+
+ (list) → NIL ; empty list
+ (list 1 2.5 \"a\" 'b) → (1 2.5 \"a\" b)"]})
+ (op apply -2 (λ rest (apply apply rest))
+ {[(fn arg . rest)+ "Return the result of applying a function to a list of arguments.
+
+ The last argument must always be a list which gets spliced as
+ arguments to the function.
+
+ Examples:
+
+ (apply + 1 2 '(3 4 5)) → 15
+ (apply vec '(1 2 3)) → #(3 4 5)
+ (apply arr 'u8 '(3 4 5)) → #vu8(3 4 5)"]})
(op + T (λ rest (apply + rest))
{[rest- "Return sum of the numbers or `0` with no arguments."]}
+ "Return sum of the arguments or `0` with none."]}
:cname "ADD")
(op - -1 (λ rest (apply - rest))
+ {[(a . rest)+ "Return the result of subtraction. With only one argument a
+ negation is performed.
+
+ Examples:
+
+ (- 1.5) → -1.5
+ (- 3 2) → 1"]}
:cname "SUB")
(op * T (λ rest (apply * rest))
{[rest- "Return product of the numbers or `1` with no arguments."]}
- :cname "MUL")
+ "Return product of the arguments or `1` with none."]}
+ :cname "MUL")
(op / -1 (λ rest (apply / rest))
+ {[(x . rest)+ "Return the division of the arguments. With only one argument the
+ result of `1/x` is returned. If the result is integer-valued, it is
+ returned as an integer.
+
+ Examples:
+
+ (/ 2) → 0.5
+ (/ 7 2 2) → 1.75
+ (/ 10 -2) → -5 ; a fixnum
+ (/ 6.9 1.9) → 3.6315…"]}
:cname "DIV")
- (op div0 2 (λ rest (apply div0 rest)))
+ (op div0 2 (λ rest (apply div0 rest))
+ {[(a b)+ "Return the quotient of two numbers. For non-integers this is
+ equivalent to `(div0 (floor a) (floor b))`. The result is always an
+ integer.
+
+ Examples:
+
+ (div0 7 2) → 3
+ (div0 10 -2) → -5
+ (div0 6.9 1.9) → 6"]})
(op = -1 (λ rest (apply = rest))
{[(a . rest)- "Numerical equality test. Return `T` if all numbers are equal,
- `NIL` otherwise."]}
- :cname "NUMEQP")
+ "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
@@ -137,8 +244,28 @@
(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 vec T (λ rest (apply vec rest))
+ {[rest+ "Return a vector constructed of the arguments.
+
+ Examples:
+
+ (vec) → #() ; empty vector
+ (vec 1 2.5 \"a\" 'b) → #(1 2.5 \"a\" b)"]})
+ (op aset! -3 (λ rest (apply aset! rest))
+ {[(sequence subscripts… new-value)+ "Modify the sequence element specified by the subscripts and return the
+ new value. The sequence can be an array, vector, a list.
+ Multi-dimensional sequences of variating types are also supported.
+
+ Examples:
+
+ (def a '((1 #(2 (3)) 4)))
+ (aset! a 1 'x) → index 1 out of bounds
+ (aset! a 0 0 'x) → x
+ a → ((x #(2 (3)) 4))
+ (aset! a 0 1 9) → 9
+ a → ((x #(9 (3)) 4))"]})
(op loadnil)
(op loadi8)
(op loadv.l)
@@ -167,10 +294,10 @@
(op brne.l)
(op brnn.l)
(op aref -2 (λ rest (apply aref rest))
- {[(seq subscript0 . rest)+ {[(sequence subscript0 . rest)"Return the sequence element specified by the subscripts. The sequence
- can be an array, vector, a list. Multi-dimensional sequences
- of variating types are also supported.
+ can be an array, vector, a list. Multi-dimensional sequences
+ of variating types are also supported.
Examples:
@@ -188,8 +315,8 @@
(def (new path)
(file path :write :create :truncate))
-(let ((c-header (new "opcodes.h"))
- (c-code (new "opcodes.c"))
+(let ((c-header (buffer)) ; to avoid broken code truncating valid files
+ (c-code (buffer))
(instructions (new "instructions.lsp"))
(builtins (new "builtins.lsp"))
(docs-ops (new "docs_ops.lsp"))
@@ -208,8 +335,14 @@
(let* {[args (car doc)][sig (cons lop args)]
[docstr (cadr doc)]}
+ (unless (= (length doc) 2)
+ (error lop ": documentation has extra data"))
+ (unless (str? docstr)
+ (error lop ": documentation must be a string"))
+ (unless (or (sym? sig) (cons? sig))
+ (error lop ": invalid signature"))
(write `(doc-for ,sig ,docstr) docs-ops)
- (io-write docs-ops "\n")))
+ (newline docs-ops)))
(op-docs op))
(put! op-to-byte lop (byte i))
(when argc
@@ -222,7 +355,7 @@
(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
@@ -234,18 +367,18 @@
(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."
,op-to-byte)
instructions)
- (io-write instructions "\n\n")
+ (newline instructions)
+ (newline instructions)
(write `(def arg-counts
"VM instructions mapped to their expected arguments count."
,op-to-argc)
instructions)
- (io-write instructions "\n")
+ (newline instructions)
(io-close instructions)
(set! op-to-closure (cons vec (reverse! op-to-closure)))
(write `(def *builtins*
@@ -252,5 +385,11 @@
"VM instructions as closures."
,op-to-closure)
builtins)
- (io-write builtins "\n")
- (io-close builtins))
+ (newline builtins)
+ (io-close builtins)
+
+ ;; at last, copy the buffers to the actual files in git repo.
+ (io-seek c-header 0)
+ (io-copy (new "opcodes.h") c-header)
+ (io-seek c-code 0)
+ (io-copy (new "opcodes.c") c-code))