Take udf-prims into account

This commit is contained in:
Justin Ethier 2017-04-04 07:45:24 +00:00
parent 206052c2ec
commit 742c55bf45

View file

@ -45,7 +45,8 @@
; prim? : exp -> boolean ; prim? : exp -> boolean
(define (prim? exp) (define (prim? exp)
(member exp *primitives*)) (or (member exp *primitives*)
(member exp *udf-prims*)))
;; Does primitive mutate any of its arguments? ;; Does primitive mutate any of its arguments?
(define (prim:mutates? exp) (define (prim:mutates? exp)
@ -597,6 +598,7 @@
;; 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)
(or
(member p '( (member p '(
Cyc-list Cyc-list
Cyc-fast-plus Cyc-fast-plus
@ -687,7 +689,8 @@
set-car! set-car!
set-cdr! set-cdr!
procedure? procedure?
set-cell!))) set-cell!))
(member p *udf-prims*)))
;; Determine if primitive receives a pointer to a local C variable ;; Determine if primitive receives a pointer to a local C variable
(define (prim/c-var-pointer p) (define (prim/c-var-pointer p)
@ -696,6 +699,7 @@
((eq? p 'Cyc-fast-sub) "common_type") ((eq? p 'Cyc-fast-sub) "common_type")
((eq? p 'Cyc-fast-mul) "common_type") ((eq? p 'Cyc-fast-mul) "common_type")
((eq? p 'Cyc-fast-div) "common_type") ((eq? p 'Cyc-fast-div) "common_type")
((member p *udf-prims*) "common_type")
(else #f))) (else #f)))
;; Determine if primitive assigns (allocates) a C variable ;; Determine if primitive assigns (allocates) a C variable
@ -751,11 +755,13 @@
((eq? p 'list->vector) "object") ((eq? p 'list->vector) "object")
((eq? p 'Cyc-installation-dir) "object") ((eq? p 'Cyc-installation-dir) "object")
((eq? p 'Cyc-compilation-environment) "object") ((eq? p 'Cyc-compilation-environment) "object")
((member p *udf-prims*) "object")
(else #f))) (else #f)))
;; Determine if primitive creates a C variable ;; Determine if primitive creates a C variable
(define (prim/cvar? exp) (define (prim/cvar? exp)
(and (prim? exp) (and (prim? exp)
(or
(member exp '( (member exp '(
Cyc-stdout Cyc-stdout
Cyc-stdin Cyc-stdin
@ -794,7 +800,8 @@
command-line-arguments command-line-arguments
Cyc-read-line Cyc-read-line
read-char peek-char read-char peek-char
cons cell)))) cons cell))
(member exp *udf-prims*))))
;; Pass continuation as the function's first parameter? ;; Pass continuation as the function's first parameter?
(define (prim:cont? exp) (define (prim:cont? exp)