Full version of (prim/data-arg? p)

This commit is contained in:
Justin Ethier 2015-11-04 02:25:50 -05:00
parent ca7afc7c59
commit 0cd4d2e796

View file

@ -555,132 +555,62 @@
(else (else
(error "unhandled primitive: " p)))) (error "unhandled primitive: " p))))
TODO:
;; Does the primitive require passing thread data as its first argument? ;; Does the primitive require passing thread data as its first argument?
(define (prim/data-arg? p) (define (prim/data-arg? p)
(member p '( (member p '(
; (cond +
; ((eq? p 'Cyc-global-vars) "Cyc_get_global_variables") -
; ((eq? p 'Cyc-get-cvar) "Cyc_get_cvar") *
; ((eq? p 'Cyc-set-cvar!) "Cyc_set_cvar") /
; ((eq? p 'Cyc-cvar?) "Cyc_is_cvar") =
; ((eq? p 'Cyc-has-cycle?) "Cyc_has_cycle") >
; ((eq? p 'Cyc-stdout) "Cyc_stdout") <
; ((eq? p 'Cyc-stdin) "Cyc_stdin") >=
; ((eq? p 'Cyc-stderr) "Cyc_stderr") <=
; ((eq? p '+) "Cyc_sum") apply
; ((eq? p '-) "Cyc_sub") Cyc-default-exception-handler
; ((eq? p '*) "Cyc_mul") open-input-file
; ((eq? p '/) "Cyc_div") open-output-file
; ((eq? p '=) "__num_eq") close-port
; ((eq? p '>) "__num_gt") close-input-port
; ((eq? p '<) "__num_lt") close-output-port
; ((eq? p '>=) "__num_gte") Cyc-flush-output-port
; ((eq? p '<=) "__num_lte") file-exists?
; ((eq? p 'apply) "apply") delete-file
; ((eq? p '%halt) "__halt") read-char
; ((eq? p 'exit) "__halt") peek-char
; ((eq? p 'Cyc-default-exception-handler) "Cyc_default_exception_handler") Cyc-read-line
; ((eq? p 'Cyc-current-exception-handler) "Cyc_current_exception_handler") Cyc-write-char
; ((eq? p 'open-input-file) "Cyc_io_open_input_file") integer->char
; ((eq? p 'open-output-file) "Cyc_io_open_output_file") string->number
; ((eq? p 'close-port) "Cyc_io_close_port") list->string
; ((eq? p 'close-input-port) "Cyc_io_close_input_port") make-vector
; ((eq? p 'close-output-port) "Cyc_io_close_output_port") list->vector
; ((eq? p 'Cyc-flush-output-port) "Cyc_io_flush_output_port") vector-length
; ((eq? p 'file-exists?) "Cyc_io_file_exists") vector-ref
; ((eq? p 'delete-file) "Cyc_io_delete_file") vector-set!
; ((eq? p 'read-char) "Cyc_io_read_char") string-append
; ((eq? p 'peek-char) "Cyc_io_peek_char") string-cmp
; ((eq? p 'Cyc-read-line) "Cyc_io_read_line") string->symbol
; ((eq? p 'Cyc-display) "Cyc_display_va") symbol->string
; ((eq? p 'Cyc-write) "Cyc_write_va") number->string
; ((eq? p 'Cyc-write-char) "Cyc_write_char") string-length
; ((eq? p 'car) "car") string-ref
; ((eq? p 'cdr) "cdr") string-set!
; ((eq? p 'caar) "caar") substring
; ((eq? p 'cadr) "cadr") Cyc-installation-dir
; ((eq? p 'cdar) "cdar") command-line-arguments
; ((eq? p 'cddr) "cddr") assq
; ((eq? p 'caaar) "caaar") assv
; ((eq? p 'caadr) "caadr") assoc
; ((eq? p 'cadar) "cadar") memq
; ((eq? p 'caddr) "caddr") memv
; ((eq? p 'cdaar) "cdaar") member
; ((eq? p 'cdadr) "cdadr") length
; ((eq? p 'cddar) "cddar") set-car!
; ((eq? p 'cdddr) "cdddr") set-cdr!
; ((eq? p 'caaaar) "caaaar") procedure?
; ((eq? p 'caaadr) "caaadr") set-cell!))
; ((eq? p 'caadar) "caadar")
; ((eq? p 'caaddr) "caaddr")
; ((eq? p 'cadaar) "cadaar")
; ((eq? p 'cadadr) "cadadr")
; ((eq? p 'caddar) "caddar")
; ((eq? p 'cadddr) "cadddr")
; ((eq? p 'cdaaar) "cdaaar")
; ((eq? p 'cdaadr) "cdaadr")
; ((eq? p 'cdadar) "cdadar")
; ((eq? p 'cdaddr) "cdaddr")
; ((eq? p 'cddaar) "cddaar")
; ((eq? p 'cddadr) "cddadr")
; ((eq? p 'cdddar) "cdddar")
; ((eq? p 'cddddr) "cddddr")
; ((eq? p 'char->integer) "Cyc_char2integer")
; ((eq? p 'integer->char) "Cyc_integer2char")
; ((eq? p 'string->number)"Cyc_string2number")
; ((eq? p 'list->string) "Cyc_list2string")
; ((eq? p 'make-vector) "Cyc_make_vector")
; ((eq? p 'list->vector) "Cyc_list2vector")
; ((eq? p 'vector-length) "Cyc_vector_length")
; ((eq? p 'vector-ref) "Cyc_vector_ref")
; ((eq? p 'vector-set!) "Cyc_vector_set")
; ((eq? p 'string-append) "Cyc_string_append")
; ((eq? p 'string-cmp) "Cyc_string_cmp")
; ((eq? p 'string->symbol) "Cyc_string2symbol")
; ((eq? p 'symbol->string) "Cyc_symbol2string")
; ((eq? p 'number->string) "Cyc_number2string")
; ((eq? p 'string-length) "Cyc_string_length")
; ((eq? p 'string-ref) "Cyc_string_ref")
; ((eq? p 'string-set!) "Cyc_string_set")
; ((eq? p 'substring) "Cyc_substring")
; ((eq? p 'Cyc-installation-dir) "Cyc_installation_dir")
; ((eq? p 'command-line-arguments) "Cyc_command_line_arguments")
; ((eq? p 'system) "Cyc_system")
; ((eq? p 'assq) "assq")
; ((eq? p 'assv) "assq")
; ((eq? p 'assoc) "assoc")
; ((eq? p 'memq) "memqp")
; ((eq? p 'memv) "memqp")
; ((eq? p 'member) "memberp")
; ((eq? p 'length) "Cyc_length")
; ((eq? p 'set-car!) "Cyc_set_car")
; ((eq? p 'set-cdr!) "Cyc_set_cdr")
; ((eq? p 'eq?) "Cyc_eq")
; ((eq? p 'eqv?) "Cyc_eq")
; ((eq? p 'equal?) "equalp")
; ((eq? p 'boolean?) "Cyc_is_boolean")
; ((eq? p 'char?) "Cyc_is_char")
; ((eq? p 'null?) "Cyc_is_null")
; ((eq? p 'number?) "Cyc_is_number")
; ((eq? p 'real?) "Cyc_is_real")
; ((eq? p 'integer?) "Cyc_is_integer")
; ((eq? p 'pair?) "Cyc_is_cons")
; ((eq? p 'procedure?) "Cyc_is_procedure")
; ((eq? p 'macro?) "Cyc_is_macro")
; ((eq? p 'port?) "Cyc_is_port")
; ((eq? p 'vector?) "Cyc_is_vector")
; ((eq? p 'string?) "Cyc_is_string")
; ((eq? p 'eof-object?) "Cyc_is_eof_object")
; ((eq? p 'symbol?) "Cyc_is_symbol")
; ((eq? p 'cons) "make_cons")
; ((eq? p 'cell) "make_cell")
; ((eq? p 'cell-get) "cell_get")
; ((eq? p 'set-cell!) "Cyc_set_car")
; ((eq? p 'set-global!) "global_set")
; (else
; (error "unhandled primitive: " p))))
))
;; Determine if primitive assigns (allocates) a C variable ;; Determine if primitive assigns (allocates) a C variable
;; EG: int v = prim(); ;; EG: int v = prim();