From ca68ab358a0fe81b97bd1769bf7a91d224dcc3d2 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 20 Mar 2017 18:17:40 -0400 Subject: [PATCH] Added fast char cmp prims --- include/cyclone/runtime.h | 5 +++++ runtime.c | 13 ++++++++++++ scheme/cyclone/primitives.sld | 38 +++++++++++++++++++++++++++++++++-- 3 files changed, 54 insertions(+), 2 deletions(-) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 5511f941..f62cd9f6 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -205,6 +205,11 @@ object Cyc_string_set(void *data, object str, object k, object chr); */ /**@{*/ object Cyc_char2integer(object chr); +object Cyc_char_eq_op(void *data, object a, object b); +object Cyc_char_gt_op(void *data, object a, object b); +object Cyc_char_lt_op(void *data, object a, object b); +object Cyc_char_gte_op(void *data, object a, object b); +object Cyc_char_lte_op(void *data, object a, object b); /**@}*/ /** diff --git a/runtime.c b/runtime.c index dd7ebc4f..a45d33e6 100644 --- a/runtime.c +++ b/runtime.c @@ -2541,6 +2541,19 @@ object Cyc_system(object cmd) return obj_int2obj(system(((string_type *) cmd)->str)); } +#define declare_char_comp(FUNC, OP) \ +object FUNC(void *data, object a, object b) \ +{ \ + if (obj_obj2char(a) OP obj_obj2char(b)) \ + return boolean_t; \ + return boolean_f; \ +} +declare_char_comp(Cyc_char_eq_op, ==); +declare_char_comp(Cyc_char_gt_op, > ); +declare_char_comp(Cyc_char_lt_op, < ); +declare_char_comp(Cyc_char_gte_op, >=); +declare_char_comp(Cyc_char_lte_op, <=); + object Cyc_char2integer(object chr) { return obj_int2obj(obj_obj2char(chr)); diff --git a/scheme/cyclone/primitives.sld b/scheme/cyclone/primitives.sld index 9172d19a..bd01cd47 100644 --- a/scheme/cyclone/primitives.sld +++ b/scheme/cyclone/primitives.sld @@ -76,6 +76,11 @@ Cyc-fast-lt Cyc-fast-gte Cyc-fast-lte + Cyc-fast-char-eq + Cyc-fast-char-gt + Cyc-fast-char-lt + Cyc-fast-char-gte + Cyc-fast-char-lte = > < @@ -203,6 +208,11 @@ (Cyc-fast-lt 2 2) (Cyc-fast-gte 2 2) (Cyc-fast-lte 2 2) + (Cyc-fast-char-eq 2 2) + (Cyc-fast-char-gt 2 2) + (Cyc-fast-char-lt 2 2) + (Cyc-fast-char-gte 2 2) + (Cyc-fast-char-lte 2 2) (- 1 #f) (/ 1 #f) (= 2 #f) @@ -445,6 +455,11 @@ ((eq? p 'Cyc-fast-lt) "Cyc_num_fast_lt_op") ((eq? p 'Cyc-fast-gte) "Cyc_num_fast_gte_op") ((eq? p 'Cyc-fast-lte) "Cyc_num_fast_lte_op") + ((eq? p 'Cyc-fast-char-eq) "Cyc_char_eq_op") + ((eq? p 'Cyc-fast-char-gt) "Cyc_char_gt_op") + ((eq? p 'Cyc-fast-char-lt) "Cyc_char_lt_op") + ((eq? p 'Cyc-fast-char-gte) "Cyc_char_gte_op") + ((eq? p 'Cyc-fast-char-lte) "Cyc_char_lte_op") ((eq? p '=) "Cyc_num_eq") ((eq? p '>) "Cyc_num_gt") ((eq? p '<) "Cyc_num_lt") @@ -584,6 +599,11 @@ Cyc-fast-lt Cyc-fast-gte Cyc-fast-lte + Cyc-fast-char-eq + Cyc-fast-char-gt + Cyc-fast-char-lt + Cyc-fast-char-gte + Cyc-fast-char-lte = > < @@ -687,6 +707,11 @@ ((eq? p 'Cyc-fast-lt) "object") ((eq? p 'Cyc-fast-gte) "object") ((eq? p 'Cyc-fast-lte) "object") + ((eq? p 'Cyc-fast-char-eq) "object") + ((eq? p 'Cyc-fast-char-gt) "object") + ((eq? p 'Cyc-fast-char-lt) "object") + ((eq? p 'Cyc-fast-char-gte) "object") + ((eq? p 'Cyc-fast-char-lte) "object") ((eq? p '=) "object") ((eq? p '>) "object") ((eq? p '<) "object") @@ -746,6 +771,11 @@ Cyc-fast-lt Cyc-fast-gte Cyc-fast-lte + Cyc-fast-char-eq + Cyc-fast-char-gt + Cyc-fast-char-lt + Cyc-fast-char-gte + Cyc-fast-char-lte + - * / apply = > < >= <= command-line-arguments @@ -802,8 +832,7 @@ (member exp '()))) ;; Does the primitive only accept/return immutable objects? - ;; This is useful during optimization, because such primitives - ;; can always be inlined without concerns for side effects + ;; This is useful during optimization (define (prim:immutable-args/result? sym) (member sym '(= > < >= <= @@ -817,6 +846,11 @@ Cyc-fast-lt Cyc-fast-gte Cyc-fast-lte + Cyc-fast-char-eq + Cyc-fast-char-gt + Cyc-fast-char-lt + Cyc-fast-char-gte + Cyc-fast-char-lte ; %halt ; exit char->integer