Coverage report: home:Documents;Work;Repo;alu;src;spec;type.lisp.newest
| Expressions | Branches | Code Forms | Functions |
| Total | Entered | % entered | Fully covered | % fully covered | total unreached | Total | Covered | % covered | Total | Fully covered | % fully covered | Partly covered | % partly covered | Not entered | % not entered |
| | | | | | | | | | | | | | | |
Key
Fully covered - every single instruction executed
Partly covered - entered but some subforms not executed
Never entered - not a single instruction executed
Uninstrumented - a form whose coverage was not measured
1 (in-package :alu.spec)
2
3 (deftype type-reference ()
4 "When we refer to the type in the language it will be through the type
5 reference. If we are apply a type, then "
6 `(or reference-type
7 ;; can be found in alu/term.lisp
8 application))
Show expansion
Show tags
(lambda (#:whole52644 #:environment52645)
(let* ((#:args52646 (funcall 'ccl::prepare-to-destructure (cdr #:whole52644) nil 0 0)))
'(or reference-type application)))
9
10 ;; dispatch-case has issue with sub checking so we inline type-reference below
11 (deftype type-reference-full ()
12 "This handles the case of references to types and what they may be
13 applied upon"
14 `(or reference-type application number))
Show expansion
Show tags
(lambda (#:whole52662 #:environment52663)
(let* ((#:args52664 (funcall 'ccl::prepare-to-destructure (cdr #:whole52662) nil 0 0)))
'(or reference-type application number)))
15
16 (defclass reference-type ()
17 ((name :initarg :name
18 :type keyword
19 :accessor name
20 :documentation "Type reference"))
21 (:documentation "Represents a variable in the Alucard language"))
22
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 ;; Array Functioanlity
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27 (-> array-type (&key (:length fixnum) (:type type-reference)) application)
28 (defun array-type (&key length type)
29 (values
30 (make-application :function (make-type-reference :name :array)
31 :arguments (list length type))))
Show expansion
Show tags
(lambda (&key ((:length length) nil #:compiler-var) ((:type type) nil #:compiler-var))
(values (funcall 'make-application
':function
(funcall 'make-type-reference ':name ':array)
':arguments
(list length type))))
32
33
34 (-> array-type-len (application) fixnum)
35 (defun array-type-len (arr)
36 (car (arguments arr)))
Show expansion
Show tags
(lambda (arr) (car (funcall 'arguments arr)))
37
38 (-> array-type-content (application) type-reference)
39 (defun array-type-content (arr)
40 (cadr (arguments arr)))
Show expansion
Show tags
(lambda (arr) (car (cdr (funcall 'arguments arr))))
41
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43 ;; Extra Functionality On Types ;;
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45
46 (defun to-type-reference-format (term)
47 "Given an application or a symbol, transform it to the correct type
48 storage format. So for example
49
50 1. int -> (make-type-reference :name :int)
51 2. (int 64) -> (make-application :name (make-type-reference :name :int)
52 :arguments (list 64))"
53 ;; can either be a list number or atom
54 (cond ((listp term)
55 (let ((type-ref (mapcar #'to-type-reference-format term)))
56 (make-application :function (car type-ref) :arguments (cdr type-ref))))
57 ((numberp term)
58 term)
59 (t
60 (make-type-reference :name (alu.utils:symbol-to-keyword term)))))
Show expansion
Show tags
(lambda (term)
(if (eq (ccl::lisptag term) 3)
(let* ((type-ref
(let* ((#:g52730 (cons nil nil)) (#:g52731 #:g52730) (#:g52733 (function to-type-reference-format)))
(let* ((#:g52734 term))
(progn (tagbody (go #:g52736)
(#:g52735 nil (0) #<var #:|tagbody-catch-tag| #x30200377E9CD> t t)
(tagbody (let* ((#:g52732 (car #:g52734)))
(tagbody (setq #:g52730
(ccl::%cdr (ccl::%rplacd #:g52730
(cons (funcall #:g52733 #:g52732)
nil)))))))
(setq #:g52734 (ccl::%cdr (ccl::typed-form 'list #:g52734)))
(#:g52736 nil (0) #<var #:|tagbody-catch-tag| #x30200377E9CD> t nil)
(if (not ':ne #:g52734) (go #:g52735) nil))
(let* () (ccl::%cdr #:g52731)))))))
(funcall 'make-application ':function (car type-ref) ':arguments (cdr type-ref)))
(if (funcall 'numberp term) term (funcall 'make-type-reference ':name (funcall 'util:symbol-to-keyword term)))))
61
62 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63 ;; Type Declaration Functions ;;
64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65
66 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
67 ;; Reference Functionality
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69
70 (defmethod print-object ((obj reference-type) stream)
71 (print-unreadable-object (obj stream :type t)
72 (format stream "~A" (name obj))))
Show expansion
Show tags
(lambda (#:next-method-context obj stream)
(flet ()
(let* ((#:g52748
(function (lambda nil
(let ((stream stream) (ccl::object (funcall 'name obj)))
(if (or (not stream)
(let* ((#:g52749 stream) (#:g52750 (ccl::typecode #:g52749)))
(if (ccl::%i<> ':eq #:g52750 166)
(ccl::%i<> ':eq
(ccl::typed-form '(unsigned-byte 8)
(ccl::%ilogand2 255
(ccl::typed-form 'fixnum
(ccl::%iasr 8
(ccl::typed-form 'fixnum
(ccl::%svref #:g52749 4))))))
201)
(ccl::%i<> ':eq #:g52750 201))))
(funcall 'ccl::format-to-string stream '"~A" ccl::object)
(progn (funcall 'princ ccl::object (if (ccl:neq ':ne stream t) stream nil)) nil)))))))
(funcall 'ccl::%print-unreadable-object obj stream t nil #:g52748))))
73
74 (defun make-type-reference (&key name)
75 (make-instance 'reference-type :name name))
Show expansion
Show tags
(lambda (&key ((:name name) nil #:compiler-var))
(let* ()
(funcall (ccl::%svref '(#:load-time-eval (funcall #<Anonymous Function #x3020037D116F>)) 3)
'(#:load-time-eval (funcall #<Anonymous Function #x3020037D116F>))
':name
name)))