diff options
Diffstat (limited to 'module/language')
-rw-r--r-- | module/language/assembly/compile-bytecode.scm | 2 | ||||
-rw-r--r-- | module/language/assembly/disassemble.scm | 4 | ||||
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 9 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 3 |
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! |