summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
Diffstat (limited to 'module/language')
-rw-r--r--module/language/assembly/compile-bytecode.scm2
-rw-r--r--module/language/assembly/disassemble.scm4
-rw-r--r--module/language/tree-il/compile-glil.scm9
-rw-r--r--module/language/tree-il/primitives.scm3
4 files changed, 17 insertions, 1 deletions
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 85805a523..bd31930fb 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -133,6 +133,8 @@
((br-if-not-eq ,l) (write-break l))
((br-if-null ,l) (write-break l))
((br-if-not-null ,l) (write-break l))
+ ((br-if-nil ,l) (write-break l))
+ ((br-if-not-nil ,l) (write-break l))
((br-if-nargs-ne ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
((br-if-nargs-lt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
((br-if-nargs-gt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l))
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index 88ea0d7d6..9a8cbbbd2 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -125,7 +125,9 @@
(case inst
((list vector)
(list "~a element~:p" (apply make-int16 args)))
- ((br br-if br-if-eq br-if-not br-if-not-eq br-if-not-null br-if-null)
+ ((br
+ br-if br-if-eq br-if-not br-if-not-eq br-if-not-null br-if-null
+ br-if-nil br-if-not-nil)
(list "-> ~A" (assq-ref labels (car args))))
((br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt)
(list "-> ~A" (assq-ref labels (caddr args))))
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index de55026ab..8c88728b8 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -110,6 +110,7 @@
((list? . 1) . list?)
((symbol? . 1) . symbol?)
((vector? . 1) . vector?)
+ ((nil? . 1) . nil?)
(list . list)
(vector . vector)
((class-of . 1) . class-of)
@@ -568,6 +569,10 @@
(comp-push (car args))
(emit-branch src 'br-if-not-null L1))
+ ((and (eq? name 'nil?) (= len 1))
+ (comp-push (car args))
+ (emit-branch src 'br-if-not-nil L1))
+
((and (eq? name 'not) (= len 1))
(let ((app (car args)))
(record-case app
@@ -586,6 +591,10 @@
(comp-push (car args))
(emit-branch src 'br-if-null L1))
+ ((and (eq? name 'nil?) (= len 1))
+ (comp-push (car args))
+ (emit-branch src 'br-if-nil L1))
+
(else
(comp-push app)
(emit-branch src 'br-if L1))))
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index f7bb5cab2..01b58d795 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -46,6 +46,7 @@
ash logand logior logxor
not
pair? null? list? symbol? vector? string? struct?
+ nil?
acons cons cons*
list vector
@@ -141,6 +142,7 @@
+ * - / 1- 1+ quotient remainder modulo
not
pair? null? list? symbol? vector? struct? string?
+ nil?
string-length
;; These all should get expanded out by expand-primitives!.
caar cadr cdar cddr
@@ -168,6 +170,7 @@
ash logand logior logxor
not
pair? null? list? symbol? vector? acons cons cons*
+ nil?
list vector
car cdr
set-car! set-cdr!