On Thu, Apr 23, 2020 at 05:07:31PM -0400, Philip McGrath wrote:
> I think you are running into the (very confusing!) issue Ben describes
> here: https://groups.google.com/d/msg/racket-users/UD20HadJ9Ec/mDd4x8Y1BwAJ
If so, I'm confused. That issue seems to deal with modules.
I'm not aware of amy modules hanging around.
The creation of resulttype, the use of resulttype, and the set!ing of
resuttype all happen within one single function.
I'll paste it in below.
-- hendrik
>
> -Philip
>
>
> On Thu, Apr 23, 2020 at 5:00 PM Hendrik Boom <hend...@topoi.pooq.com> wrote:
>
> > extract from code:
> >
> > (fprintf anomaly "resEEEulttyope was ~s~n" resulttype)
> > (fprintf anomaly "set resulttyoe to ~s~n" ty)
> > ` (set! resulttype ty)
> > (fprintf anomaly "resEEulttyope now ~s~n" resulttype)
> >
> > Previous creation of resulttype:
> >
> > (define resulttype : (Option TType) #f) ; TODO: check there's only one
> >
> > Output that appeared on the anomaly file:
> >
> > resEEEulttyope was #f
> > set resulttyoe to _void
> > resEEulttyope now #f
> >
> > I stuck the E's in just to make sure these were the statements really
> > generating that output.
> >
> > If I am correct, the set! should have changed the value of resulttype.
> > I'm doing thie in typed-racket.
And here's the function:
(define (process-command [command : (Listof XML)])
(fprintf output "~n") ; TODO this line is temporary code
(define name : (Option Symbol) #f) ; TODO: check there's only one
(define resulttype : (Option TType) #f) ; TODO: check there's only one
(define group : (Option XML) #f)
(define proto : (Option prototype) #f); TODO: check there's only one
(define params : (Listof parameter)'()) ; list of parameters in reverse order
(define glxtype : (Option String) #f)
(define opcode : (Option String) #f)
(for ([item command])
(match item
#;[(list 'proto ty (list 'name n))
` (set! resulttype
` (if (and (string? ty) (equal? "void" (strip-white ty))) '_void
ty))
` (fprintf anomaly "resulttype set to ~s~n" resulttype)`
` (set! name (string->symbol (strip-white n)))
]
[(cons 'proto rest)
(set! proto (process-proto (cast rest (Listof XML))))
(match proto
[(prototype ty n g) ; formerly list n ': t)
(fprintf anomaly "!!!! prottype's type is ~s~n" ty)
(when name (fprintf anomaly "Too many names ~s ~s~n" name n))
(set! name n)
(when resulttype (fprintf anomaly "Too many result types ~s ~s`n"
resulttype ty))
(fprintf anomaly "resEEEulttyope was ~s~n" resulttype)
(fprintf anomaly "set resulttyoe to ~s~n" ty)
` (set! resulttype ty)
(fprintf anomaly "resEEulttyope now ~s~n" resulttype)
(when group (fprintf anomaly "Too many groupss ~s ~s`n" group g))
` (set! group g) #;(fprintf anomaly "proto had group ~s\n" g)
]
[ _ (fprintf anomaly "; TODO: strange proto in command: ~s~n" command)]
)]
[(cons 'param rest) (set! params (cons (parse-param (cast rest (Listof
XML))) params))]
[(list 'glx (list '@ (list 'type (? string? t)) (list 'opcode (? string?
o))))
(set! glxtype t)
(set! opcode o)
(fprintf anomaly "; LATER: whatever do i do with item ~s in command
~s~n" item name)]
[(list 'alias (list '@ (list 'name name)))
(fprintf output "; alias for ~a~n" name)]
[(list 'vecequiv (list '@ (list 'name name)))
(fprintf anomaly "; LATER vecequiv ~s~n" item)]
[ _ (fprintf anomaly "; TODO: unknown command item ~s~n" item) ]
))
(when (null? name)
#;(fprintf anomaly "; TODO: no name in command definition~n")
(fprintf anomaly "; TODO: best try:~n #;")
)
(fprintf output "TODO: debug: Parameter list is ~s from command ~s~n" params
command)
(fprintf trace "; DEBUGG ~s~n" (map parameter-type params))
(define args (params->ctypes params))
(define results : (Listof (List Symbol ': TType)) (get-output-ctypes args)) ;
parameters used as output variables
(fprintf output "got results ~s from args ~s~n" results args)
; (define rev-regular-type (cons '-> (map (lambda ([a :(List Boolean Symbol ':
TType)]) (cdr a)) args))) ; <><><><>
(define rev-regular-type
(cons '-> (map (ann cdr (-> (List Boolean Symbol ': TType) (List Symbol ':
TType))) args))) ; <><><><>
(fprintf output "!!!! resulttype ~s~n" resulttype)
(define rev-type ; the type for the C ffi.
(if (null? results)
(cons resulttype rev-regular-type)
(cons (cons 'values
(cons 'result (map (lambda ([a : (List Symbol ': TType)])
(car a))
(cast results (Listof (List Symbol ':
TType)))
)))
(cons '-> (cons (list 'result ': resulttype) rev-regular-type))
)
))
(fprintf output "!!!!! rev-type ~s~n" rev-type)
(fprintf output "~s~n"
(list 'define-gl name
(- (length params) (length results)) ; This is wroneg. I
suspect is has to be altered when there are output parameters, but I don't
really know.
(reverse rev-type) ; the ctype of the function
(cons '->> ; this part is still very wwrong and currently
generates gibberish.
(reverse (cons (racket-contract (or resulttype '_void))
(map racket-contract ; <><><>
#;(map parameter-type params)
(map (ann cadddr(-> (List
Boolean Symbol ': TType) TType) ) args)
)
)))
(if (equal? group "ErrorCode") 'void 'check-gl-error)
; TODO: when to generate check-gl-error?
; glGetError has void instead of check-gl-error in this spot
; in the old binding.
; many functions have check-gl-error
; Presumably this is to know when to test for errors on
function return
; an connect with Rackets error handling.
; Maybe ... group="ErrorCode" as a prototype attribute
should tell me to generate void instead of check-gl-error.
)
)
(unless (or (null? opcode) (null? glxtype))
(fprintf anomaly "; LATER: what to do with type ~s opcode ~s~n"
glxtype opcode))
)
--
You received this message because you are subscribed to the Google Groups
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to racket-users+unsubscr...@googlegroups.com.
To view this discussion on the web visit
https://groups.google.com/d/msgid/racket-users/20200424021559.ohyp6djmfddoc2yv%40topoi.pooq.com.
