ref: 7021166d135ee90cbcea5a689c2adacad93985e7
parent: bd1993ab44c9edaa2403cf563580cc72e98cddf6
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Dec 30 00:11:19 EST 2024
produce docs for VM opcodes that are callable (thanks willowgl)
--- a/docs_extra.lsp
+++ b/docs_extra.lsp
@@ -28,4 +28,6 @@
the decompressed data must be specified. In the latter case a new
array is allocated.")
+(load "docs_ops.lsp")
+
(del! *syntax-environment* 'doc-for)
--- /dev/null
+++ b/docs_ops.lsp
@@ -1,0 +1,2 @@
+(doc-for (car lst) "Returns the first element of a list or nil if not available.")
+(doc-for (cdr lst) "Returns the tail of a list or nil if not available.")
--- a/flisp.boot
+++ b/flisp.boot
@@ -16,7 +16,7 @@
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #fn("8000z0700}2:" #(aref)) 0 0)*properties* #table(*funvars* #table(lz-unpack ((data :to destination)
(data :size decompressed-bytes)) void? ((x)) length= ((lst
- n)) help ((term)) void (rest) *prompt* (nil) lz-pack ((data (level 0))) vm-stats (nil)) *doc* #table(lz-unpack "Return decompressed data previously compressed using lz-pack.\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." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." void "Return the constant #<void> while ignoring any arguments.\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." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
+ n)) help ((term)) void (rest) *prompt* (nil) lz-pack ((data (level 0))) vm-stats (nil) car ((lst)) cdr ((lst))) *doc* #table(cdr "Returns the tail of a list or nil if not available." lz-unpack "Return decompressed data previously compressed using lz-pack.\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." void? "Return #t if x is #<void> and #f otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." help "Display documentation for the specified term, if available." void "Return the constant #<void> while ignoring any arguments.\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." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." car "Returns the first element of a list or nil if not available." *builtins* "VM instructions as closures." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
*runestring-type* (array rune) *string-type* (array byte)
*syntax-environment* #table(unwind-protect #fn("A000n220502050218722q1e3e2e1232402286e12587e12686e2e3e3e387e1e3e3:" #(#fn(gensym) let λ prog1 trycatch begin raise)) help #fn(";000n17002152853W072855147350424250>170026q535247350@B0722728051524735047960:" #(getpropbinary files a/flisp.boot.builtin b/flisp.boot.builtin differ
--- a/gen.lsp
+++ b/gen.lsp
@@ -1,100 +1,102 @@
(define opcodes '(
- ; C opcode, lisp compiler opcode, arg count, builtin lambda
- OP_LOADA0 loada0 #f 0
- OP_LOADA1 loada1 #f 0
- OP_LOADV loadv #f 0
- OP_BRF brf #f 0
- OP_POP pop #f 0
- OP_CALL call #f 0
- OP_TCALL tcall #f 0
- OP_LOADG loadg #f 0
- OP_LOADA loada #f 0
- OP_LOADC loadc #f 0
- OP_RET ret #f 0
- OP_DUP dup #f 0
- OP_CAR car 1 (λ (x) (car x))
- OP_CDR cdr 1 (λ (x) (cdr x))
- OP_CLOSURE closure #f 0
- OP_SETA seta #f 0
- OP_JMP jmp #f 0
- OP_LOADC0 loadc0 #f 0
- OP_CONSP cons? 1 (λ (x) (cons? x))
- OP_BRNE brne #f 0
- OP_LOADT loadt #f 0
- OP_LOAD0 load0 #f 0
- OP_LOADC1 loadc1 #f 0
- OP_AREF2 aref2 #f 0
- OP_ATOMP atom? 1 (λ (x) (atom? x))
- OP_BRT brt #f 0
- OP_BRNN brnn #f 0
- OP_LOAD1 load1 #f 0
- OP_LT < 2 (λ (x y) (< x y))
- OP_ADD2 add2 #f 0
- OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y))
- OP_LOADF loadf #f 0
- OP_CONS cons 2 (λ (x y) (cons x y))
- OP_EQ eq? 2 (λ (x y) (eq? x y))
- OP_SYMBOLP symbol? 1 (λ (x) (symbol? x))
- OP_NOT not 1 (λ (x) (not x))
- OP_CADR cadr 1 (λ (x) (cadr x))
- OP_NEG neg #f 0
- OP_NULLP null? 1 (λ (x) (null? x))
- OP_BOOLEANP boolean? 1 (λ (x) (boolean? x))
- OP_NUMBERP number? 1 (λ (x) (number? x))
- OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x))
- OP_BOUNDP bound? 1 (λ (x) (bound? x))
- OP_BUILTINP builtin? 1 (λ (x) (builtin? x))
- OP_FUNCTIONP function? 1 (λ (x) (function? x))
- OP_VECTORP vector? 1 (λ (x) (vector? x))
- OP_SHIFT shift #f 0
- OP_SETCAR set-car! 2 (λ (x y) (set-car! x y))
- OP_JMPL jmp.l #f 0
- OP_BRFL brf.l #f 0
- OP_BRTL brt.l #f 0
- OP_EQV eqv? 2 (λ (x y) (eqv? x y))
- OP_EQUAL equal? 2 (λ (x y) (equal? x y))
- OP_LIST list ANYARGS (λ rest rest)
- OP_APPLY apply -2 (λ rest (apply apply rest))
- OP_ADD + ANYARGS (λ rest (apply + rest))
- OP_SUB - -1 (λ rest (apply - rest))
- OP_MUL * ANYARGS (λ rest (apply * rest))
- OP_DIV / -1 (λ rest (apply / rest))
- OP_IDIV div0 2 (λ rest (apply div0 rest))
- OP_NUMEQ = 2 (λ (x y) (= x y))
- OP_COMPARE compare 2 (λ (x y) (compare x y))
- OP_ARGC argc #f 0
- OP_VECTOR vector ANYARGS (λ rest (apply vector rest))
- OP_ASET aset! -3 (λ rest (apply aset! rest))
- OP_LOADNIL loadnil #f 0
- OP_LOADI8 loadi8 #f 0
- OP_LOADVL loadv.l #f 0
- OP_LOADGL loadg.l #f 0
- OP_LOADAL loada.l #f 0
- OP_LOADCL loadc.l #f 0
- OP_SETG setg #f 0
- OP_SETGL setg.l #f 0
- OP_SETAL seta.l #f 0
- OP_VARGC vargc #f 0
- OP_TRYCATCH trycatch #f 0
- OP_FOR for 3 (λ (a b f) (for a b (λ (x) (f x))))
- OP_TAPPLY tapply #f 0
- OP_SUB2 sub2 #f 0
- OP_LARGC largc #f 0
- OP_LVARGC lvargc #f 0
- OP_CALLL call.l #f 0
- OP_TCALLL tcall.l #f 0
- OP_BRNEL brne.l #f 0
- OP_BRNNL brnn.l #f 0
- OP_BRN brn #f 0
- OP_BRNL brn.l #f 0
- OP_OPTARGS optargs #f 0
- OP_BRBOUND brbound #f 0
- OP_KEYARGS keyargs #f 0
- OP_BOX box #f 0
- OP_BOXL box.l #f 0
- OP_AREF aref -2 (λ rest (apply aref rest))
- OP_LOADVOID loadvoid #f 0
- OP_EOF_OBJECT dummy_eof #f 0
+ ; C opcode, lisp compiler opcode, arg count, builtin lambda, DOC (NEW)
+ OP_LOADA0 loada0 #f 0 ()
+ OP_LOADA1 loada1 #f 0 ()
+ OP_LOADV loadv #f 0 ()
+ OP_BRF brf #f 0 ()
+ OP_POP pop #f 0 ()
+ OP_CALL call #f 0 ()
+ OP_TCALL tcall #f 0 ()
+ OP_LOADG loadg #f 0 ()
+ OP_LOADA loada #f 0 ()
+ OP_LOADC loadc #f 0 ()
+ OP_RET ret #f 0 ()
+ OP_DUP dup #f 0 ()
+ OP_CAR car 1 (λ (x) (car x)) (
+ ((lst) "Returns the first element of a list or nil if not available."))
+ OP_CDR cdr 1 (λ (x) (cdr x)) (
+ ((lst) "Returns the tail of a list or nil if not available."))
+ OP_CLOSURE closure #f 0 ()
+ OP_SETA seta #f 0 ()
+ OP_JMP jmp #f 0 ()
+ OP_LOADC0 loadc0 #f 0 ()
+ OP_CONSP cons? 1 (λ (x) (cons? x)) ()
+ OP_BRNE brne #f 0 ()
+ OP_LOADT loadt #f 0 ()
+ OP_LOAD0 load0 #f 0 ()
+ OP_LOADC1 loadc1 #f 0 ()
+ OP_AREF2 aref2 #f 0 ()
+ OP_ATOMP atom? 1 (λ (x) (atom? x)) ()
+ OP_BRT brt #f 0 ()
+ OP_BRNN brnn #f 0 ()
+ OP_LOAD1 load1 #f 0 ()
+ OP_LT < 2 (λ (x y) (< x y)) ()
+ OP_ADD2 add2 #f 0 ()
+ OP_SETCDR set-cdr! 2 (λ (x y) (set-cdr! x y)) ()
+ OP_LOADF loadf #f 0 ()
+ OP_CONS cons 2 (λ (x y) (cons x y)) ()
+ OP_EQ eq? 2 (λ (x y) (eq? x y)) ()
+ OP_SYMBOLP symbol? 1 (λ (x) (symbol? x)) ()
+ OP_NOT not 1 (λ (x) (not x)) ()
+ OP_CADR cadr 1 (λ (x) (cadr x)) ()
+ OP_NEG neg #f 0 ()
+ OP_NULLP null? 1 (λ (x) (null? x)) ()
+ OP_BOOLEANP boolean? 1 (λ (x) (boolean? x)) ()
+ OP_NUMBERP number? 1 (λ (x) (number? x)) ()
+ OP_FIXNUMP fixnum? 1 (λ (x) (fixnum? x)) ()
+ OP_BOUNDP bound? 1 (λ (x) (bound? x)) ()
+ OP_BUILTINP builtin? 1 (λ (x) (builtin? x)) ()
+ OP_FUNCTIONP function? 1 (λ (x) (function? x)) ()
+ OP_VECTORP vector? 1 (λ (x) (vector? x)) ()
+ OP_SHIFT shift #f 0 ()
+ OP_SETCAR set-car! 2 (λ (x y) (set-car! x y)) ()
+ OP_JMPL jmp.l #f 0 ()
+ OP_BRFL brf.l #f 0 ()
+ OP_BRTL brt.l #f 0 ()
+ OP_EQV eqv? 2 (λ (x y) (eqv? x y)) ()
+ OP_EQUAL equal? 2 (λ (x y) (equal? x y)) ()
+ OP_LIST list ANYARGS (λ rest rest) ()
+ OP_APPLY apply -2 (λ rest (apply apply rest)) ()
+ OP_ADD + ANYARGS (λ rest (apply + rest)) ()
+ OP_SUB - -1 (λ rest (apply - rest)) ()
+ OP_MUL * ANYARGS (λ rest (apply * rest)) ()
+ OP_DIV / -1 (λ rest (apply / rest)) ()
+ OP_IDIV div0 2 (λ rest (apply div0 rest)) ()
+ OP_NUMEQ = 2 (λ (x y) (= x y)) ()
+ OP_COMPARE compare 2 (λ (x y) (compare x y)) ()
+ OP_ARGC argc #f 0 ()
+ OP_VECTOR vector ANYARGS (λ rest (apply vector rest)) ()
+ OP_ASET aset! -3 (λ rest (apply aset! rest)) ()
+ OP_LOADNIL loadnil #f 0 ()
+ OP_LOADI8 loadi8 #f 0 ()
+ OP_LOADVL loadv.l #f 0 ()
+ OP_LOADGL loadg.l #f 0 ()
+ OP_LOADAL loada.l #f 0 ()
+ OP_LOADCL loadc.l #f 0 ()
+ OP_SETG setg #f 0 ()
+ OP_SETGL setg.l #f 0 ()
+ OP_SETAL seta.l #f 0 ()
+ OP_VARGC vargc #f 0 ()
+ OP_TRYCATCH trycatch #f 0 ()
+ OP_FOR for 3 (λ (a b f) (for a b (λ (x) (f x)))) ()
+ OP_TAPPLY tapply #f 0 ()
+ OP_SUB2 sub2 #f 0 ()
+ OP_LARGC largc #f 0 ()
+ OP_LVARGC lvargc #f 0 ()
+ OP_CALLL call.l #f 0 ()
+ OP_TCALLL tcall.l #f 0 ()
+ OP_BRNEL brne.l #f 0 ()
+ OP_BRNNL brnn.l #f 0 ()
+ OP_BRN brn #f 0 ()
+ OP_BRNL brn.l #f 0 ()
+ OP_OPTARGS optargs #f 0 ()
+ OP_BRBOUND brbound #f 0 ()
+ OP_KEYARGS keyargs #f 0 ()
+ OP_BOX box #f 0 ()
+ OP_BOXL box.l #f 0 ()
+ OP_AREF aref -2 (λ rest (apply aref rest)) ()
+ OP_LOADVOID loadvoid #f 0 ()
+ OP_EOF_OBJECT dummy_eof #f 0 ()
))
(define (for-each-n f lst n)
@@ -105,6 +107,7 @@
(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))
@@ -112,19 +115,28 @@
(i 0))
(begin
(io-write c-header "typedef enum {\n")+
(for-each-n
- (λ (cop lop argc f)
+ (λ (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 i)
- (if argc (put! cl cop (list lop argc)))
- (if (and (number? argc) (>= argc 0)) (put! ac lop argc))
+ (when argc
+ (put! cl cop (list lop argc))
+ (when (and (number? argc) (>= argc 0)) (put! ac lop argc)))
(set! lms (cons f lms))
(set! i (1+ i))))
- opcodes 4)
+ opcodes 5)
+ (io-close builtins-doc)
(io-write c-header "\tN_OPCODES\n}opcode_t;\n\n")
(io-write c-header "extern const Builtin builtins[N_OPCODES];\n")
(io-close c-header)
@@ -147,5 +159,5 @@
(write `(define arg-counts ,ac) instructions)
(io-close instructions)
(set! lms (cons vector (reverse! lms)))
- (write `(define *builtins* ,lms) builtins)
+ (write `(define *builtins* "VM instructions as closures.",lms) builtins)
(io-close builtins)))