IsaacShoebottom/CS4613
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

wip

Browse Source
This commit is contained in:
Isaac Shoebottom 2025-04-10 04:13:12 -03:00
parent f6990aa0c7
commit 647ea45733
1 changed files with 17 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Assignments/04.rkt
View File

@ -127,8 +127,23 @@
(if (equal? var-t val-t) (if (equal? var-t val-t)
body-t body-t
(error 'typecheck "type does not match annotation")))] (error 'typecheck "type does not match annotation")))]
[(objE fields) ....] [(objE fields) (let* ([extract-exp (lambda (obj) (pair (fst obj) (typecheck (snd obj) env)))]
[(msgE obj selector) ....] ))) [field-list (map extract-exp fields)])
(objT (make-hash field-list)))]
[(msgE obj selector) (type-case Exp obj
[(objE fields) (type-case (Optionof Exp) (hash-ref (make-hash fields) selector)
[(none) (error 'typecheck "unknown field")]
[(some v) (typecheck v env)])]
[(varE name) (type-case Type (type-lookup name env)
[(objT fields) (type-case (Optionof Type) (hash-ref fields selector)
[(none) (error 'typecheck "dasdas")]
[(some v) (type-case Type v
[(arrowT a b) b]
[else (error 'dasdas "dasdas")])])]
[else (error 'typecheck "bound variable is not an object")])]
[else (error 'typecheck "passing message to non-object")])]
)))
(define (parse-error sx) (define (parse-error sx)
(error 'parse (string-append "parse error: " (to-string sx)))) (error 'parse (string-append "parse error: " (to-string sx))))