Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-14 16:27:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added required args for primitives

Browse source
This commit is contained in:
Justin Ethier 2016-07-11 22:55:15 -04:00
parent a72a7e1718
commit 07163817c6
1 changed files with 130 additions and 132 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

262
scheme/cyclone/primitives.sld
View file

@ -164,137 +164,135 @@
;; can take any number of arguments then no validation is ;; can take any number of arguments then no validation is
;; required and the primitive does not need to be listed. ;; required and the primitive does not need to be listed.
(define *primitives-num-args* '( (define *primitives-num-args* '(
; (Cyc-global-vars (Cyc-global-vars 0 0)
; (Cyc-get-cvar (Cyc-get-cvar 1 1)
; (Cyc-set-cvar! (Cyc-set-cvar! 2 2)
; (Cyc-cvar? (Cyc-cvar? 1 1)
; (Cyc-opaque? (Cyc-opaque? 1 1)
; (Cyc-has-cycle? (Cyc-has-cycle? 1 1)
; (Cyc-spawn-thread! (Cyc-spawn-thread! 1 1)
; (Cyc-end-thread! (Cyc-end-thread! 0 0)
; (Cyc-stdout (Cyc-stdout 0 0)
; (Cyc-stdin (Cyc-stdin 0 0)
; (Cyc-stderr (Cyc-stderr 0 0)
; (+
(- 1 #f) (- 1 #f)
; (* (/ 1 #f)
; (/ (= 2 #f)
; (= (> 2 #f)
; (> (< 2 #f)
; (< (>= 2 #f)
; (>= (<= 2 #f)
; (<= (apply 1 #f)
; (apply (%halt 1 1)
; (%halt (exit 1 1)
; (exit (system 1 1)
; (system (command-line-arguments 0 0)
; (command-line-arguments (Cyc-installation-dir 1 1)
; (Cyc-installation-dir (Cyc-default-exception-handler 1 1)
; (Cyc-default-exception-handler (Cyc-current-exception-handler 0 0)
; (Cyc-current-exception-handler (cons 2 2)
; (cons (cell-get 1 1)
; (cell-get (set-global! 2 2)
; (set-global! (set-cell! 2 2)
; (set-cell! (cell 1 1)
; (cell (eq? 2 2)
; (eq? (eqv? 2 2)
; (eqv? (equal? 2 2)
; (equal? (assoc 2 2)
; (assoc (assq 2 2)
; (assq (assv 2 2)
; (assv (memq 2 2)
; (memq (memv 2 2)
; (memv (member 2 2)
; (member (length 1 1)
; (length (set-car! 2 2)
; (set-car! (set-cdr! 2 2)
; (set-cdr! (car 1 1)
; (car (cdr 1 1)
; (cdr (caar 1 1)
; (caar (cadr 1 1)
; (cadr (cdar 1 1)
; (cdar (cddr 1 1)
; (cddr (caaar 1 1)
; (caaar (caadr 1 1)
; (caadr (cadar 1 1)
; (cadar (caddr 1 1)
; (caddr (cdaar 1 1)
; (cdaar (cdadr 1 1)
; (cdadr (cddar 1 1)
; (cddar (cdddr 1 1)
; (cdddr (caaaar 1 1)
; (caaaar (caaadr 1 1)
; (caaadr (caadar 1 1)
; (caadar (caaddr 1 1)
; (caaddr (cadaar 1 1)
; (cadaar (cadadr 1 1)
; (cadadr (caddar 1 1)
; (caddar (cadddr 1 1)
; (cadddr (cdaaar 1 1)
; (cdaaar (cdaadr 1 1)
; (cdaadr (cdadar 1 1)
; (cdadar (cdaddr 1 1)
; (cdaddr (cddaar 1 1)
; (cddaar (cddadr 1 1)
; (cddadr (cdddar 1 1)
; (cdddar (cddddr 1 1)
; (cddddr (char->integer 1 1)
; (char->integer (integer->char 1 1)
; (integer->char (string->number 1 2)
; (string->number (string-append #f #f)
; (string-append (string-cmp 2 2)
; (string-cmp (list->string 1 1)
; (list->string (string->symbol 1 1)
; (string->symbol (symbol->string 1 1)
; (symbol->string (number->string 1 2)
; (number->string (string-length 1 1)
; (string-length (string-ref 2 2)
; (string-ref (string-set! 3 3)
; (string-set! (substring 3 3)
; (substring (make-bytevector 1 #f)
; (make-bytevector (bytevector-length 1 1)
; (bytevector-length (bytevector #f #f)
; (bytevector (bytevector-append #f #f)
; (bytevector-append (Cyc-bytevector-copy 3 3)
; (Cyc-bytevector-copy (Cyc-utf8->string 3 3)
; (Cyc-utf8->string (Cyc-string->utf8 3 3)
; (Cyc-string->utf8 (bytevector-u8-ref 2 2)
; (bytevector-u8-ref (bytevector-u8-set! 3 3)
; (bytevector-u8-set! (bytevector? 1 1)
; (bytevector? (make-vector 1 #f)
; (make-vector (list->vector 1 1)
; (list->vector (vector-length 1 1)
; (vector-length (vector-ref 2 2)
; (vector-ref (vector-set! 3 3)
; (vector-set! (boolean? 1 1)
; (boolean? (char? 1 1)
; (char? (eof-object? 1 1)
; (eof-object? (null? 1 1)
; (null? (number? 1 1)
; (number? (real? 1 1)
; (real? (integer? 1 1)
; (integer? (pair? 1 1)
; (pair? (port? 1 1)
; (port? (procedure? 1 1)
; (procedure? (macro? 1 1)
; (macro? (vector? 1 1)
; (vector? (string? 1 1)
; (string? (symbol? 1 1)
; (symbol? (open-input-file 1 1)
; (open-input-file (open-output-file 1 1)
; (open-output-file (close-port 1 1)
; (close-port (close-input-port 1 1)
; (close-input-port (close-output-port 1 1)
; (close-output-port (Cyc-flush-output-port 1 1)
; (Cyc-flush-output-port (file-exists? 1 1)
; (file-exists? (delete-file 1 1)
; (delete-file (read-char 1 1)
; (read-char (peek-char 1 1)
; (peek-char (Cyc-read-line 1 1)
; (Cyc-read-line (Cyc-write-char 1 2)
; (Cyc-write-char (Cyc-write 1 2)
; (Cyc-write (Cyc-display 1 2)
; (Cyc-display
)) ))
;; Return #f the primitive cannot accept the given number of ;; Return #f the primitive cannot accept the given number of
@ -315,10 +313,10 @@
((and (not (null? (cdr expected))) ((and (not (null? (cdr expected)))
(cadr expected) (cadr expected)
(> num-args (cadr expected))) (> num-args (cadr expected)))
(error (build-error-str "Expected " (car expected) num-args) sym)) (error (build-error-str "Expected " (car expected) num-args)))
((and (car expected) ((and (car expected)
(< num-args (car expected))) (< num-args (car expected)))
(error (build-error-str "Expected at least " (car expected) num-args) sym)) (error (build-error-str "Expected at least " (car expected) num-args)))
(else #t)))) (else #t))))