X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Flanguage%2Fexpressions%2Foperations.def;h=7bcc02da3189260294a8b19bec560fa1784dcc7b;hb=c8adc6783134063d4ada34a58f9e7abf6a039bb2;hp=d78827a8da8aaf933dc3d6fc2be09774ba39b9f7;hpb=729b96a6bd9342c45e6f65a113fd87c70da85b0a;p=pspp diff --git a/src/language/expressions/operations.def b/src/language/expressions/operations.def index d78827a8da..7bcc02da31 100644 --- a/src/language/expressions/operations.def +++ b/src/language/expressions/operations.def @@ -1,18 +1,18 @@ // -*- c -*- // // PSPP - a program for statistical analysis. -// Copyright (C) 2005, 2006, 2009 Free Software Foundation, Inc. -// +// Copyright (C) 2005, 2006, 2009, 2010, 2011, 2012, 2015, 2016 Free Software Foundation, Inc. +// // This program is free software: you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 3 of the License, or // (at your option) any later version. -// +// // This program is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. -// +// // You should have received a copy of the GNU General Public License // along with this program. If not, see . @@ -63,12 +63,12 @@ boolean operator LT (a, b) = a < b; boolean operator NE (a, b) = a != b; // String relational operators. -boolean operator EQ_STRING (string a, string b) = compare_string (&a, &b) == 0; -boolean operator GE_STRING (string a, string b) = compare_string (&a, &b) >= 0; -boolean operator GT_STRING (string a, string b) = compare_string (&a, &b) > 0; -boolean operator LE_STRING (string a, string b) = compare_string (&a, &b) <= 0; -boolean operator LT_STRING (string a, string b) = compare_string (&a, &b) < 0; -boolean operator NE_STRING (string a, string b) = compare_string (&a, &b) != 0; +boolean operator EQ_STRING (string a, string b) = compare_string_3way (&a, &b) == 0; +boolean operator GE_STRING (string a, string b) = compare_string_3way (&a, &b) >= 0; +boolean operator GT_STRING (string a, string b) = compare_string_3way (&a, &b) > 0; +boolean operator LE_STRING (string a, string b) = compare_string_3way (&a, &b) <= 0; +boolean operator LT_STRING (string a, string b) = compare_string_3way (&a, &b) < 0; +boolean operator NE_STRING (string a, string b) = compare_string_3way (&a, &b) != 0; // Unary functions. function ABS (x) = fabs (x); @@ -84,11 +84,15 @@ function LG10(x) = check_errno (log10 (x)); function LN (x) = check_errno (log (x)); function LNGAMMA (x >= 0) = gsl_sf_lngamma (x); function MOD10 (x) = fmod (x, 10); -function RND (x) = x >= 0. ? floor (x + .5) : -floor (-x + .5); +function RND (x) = round_nearest (x, 1, 0); +function RND (x, mult != 0) = round_nearest (x, mult, 0); +function RND (x, mult != 0, fuzzbits >= 0) = round_nearest (x, mult, fuzzbits); function SIN (x) = sin (x); function SQRT (x >= 0) = sqrt (x); function TAN (x) = check_errno (tan (x)); -function TRUNC (x) = x >= 0. ? floor (x) : -floor (-x); +function TRUNC (x) = round_zero (x, 1, 0); +function TRUNC (x, mult != 0) = round_zero (x, mult, 0); +function TRUNC (x, mult != 0, fuzzbits >= 0) = round_zero (x, mult, fuzzbits); absorb_miss function MOD (n, d) { @@ -99,18 +103,18 @@ absorb_miss function MOD (n, d) } // N-ary numeric functions. -absorb_miss boolean function ANY (x != SYSMIS, a[n]) +absorb_miss boolean function ANY (x, a[n]) { - int sysmis = 0; - size_t i; - - for (i = 0; i < n; i++) - if (a[i] == x) - return 1.; - else if (a[i] == SYSMIS) - sysmis = 1; - - return sysmis ? SYSMIS : 0.; + double retval = SYSMIS; + if (x != SYSMIS) + { + for (size_t i = 0; i < n; i++) + if (a[i] == x) + return 1.; + else if (a[i] != SYSMIS) + retval = 0.; + } + return retval; } boolean function ANY (string x, string a[n]) @@ -118,7 +122,7 @@ boolean function ANY (string x, string a[n]) size_t i; for (i = 0; i < n; i++) - if (!compare_string (&x, &a[i])) + if (!compare_string_3way (&x, &a[i])) return 1.; return 0.; } @@ -154,7 +158,7 @@ string function MAX (string a[n]) max = &a[0]; for (i = 1; i < n; i++) - if (compare_string (&a[i], max) > 0) + if (compare_string_3way (&a[i], max) > 0) max = &a[i]; return *max; } @@ -166,6 +170,11 @@ function MEAN.1 (a[n]) return mean; } +function MEDIAN.1 (a[n]) +{ + return median (a, n); +} + function MIN.1 (a[n]) { double min; @@ -185,63 +194,61 @@ string function MIN (string a[n]) min = &a[0]; for (i = 1; i < n; i++) - if (compare_string (&a[i], min) < 0) + if (compare_string_3way (&a[i], min) < 0) min = &a[i]; return *min; } absorb_miss function NMISS (a[n]) { - size_t i; - size_t missing_cnt = 0; - - for (i = 0; i < n; i++) - missing_cnt += a[i] == SYSMIS; - return missing_cnt; + size_t n_missings = 0; + for (size_t i = 0; i < n; i++) + n_missings += a[i] == SYSMIS; + return n_missings; } absorb_miss function NVALID (a[n]) { - size_t i; - size_t valid_cnt = 0; - - for (i = 0; i < n; i++) - valid_cnt += a[i] != SYSMIS; - return valid_cnt; + size_t n_valids = 0; + for (size_t i = 0; i < n; i++) + n_valids += a[i] != SYSMIS; + return n_valids; } absorb_miss boolean function RANGE (x != SYSMIS, a[n*2]) { - size_t i; - int sysmis = 0; - - for (i = 0; i < n; i++) + bool found = false; + bool valid = false; + for (size_t i = 0; i < n; i++) { double w = a[2 * i]; double y = a[2 * i + 1]; if (w != SYSMIS && y != SYSMIS) { if (w <= x && x <= y) - return 1.0; + found = true; + else if (w <= y) + valid = true; + else + return SYSMIS; } - else - sysmis = 1; } - return sysmis ? SYSMIS : 0.; + return found ? true : valid ? false : SYSMIS; } boolean function RANGE (string x, string a[n*2]) { - int i; - - for (i = 0; i < n; i++) + bool found = false; + for (size_t i = 0; i < n; i++) { struct substring *w = &a[2 * i]; struct substring *y = &a[2 * i + 1]; - if (compare_string (w, &x) <= 0 && compare_string (&x, y) <= 0) - return 1.; + if (compare_string_3way (w, &x) <= 0 && compare_string_3way (&x, y) <= 0) + found = true; + else if (compare_string_3way (w, y) > 0) + return SYSMIS; } - return 0.; + return found; } function SD.2 (a[n]) @@ -272,10 +279,22 @@ function VARIANCE.2 (a[n]) // Time construction & extraction functions. function TIME.HMS (h, m, s) + expression e; + expr_node n; { if ((h > 0. || m > 0. || s > 0.) && (h < 0. || m < 0. || s < 0.)) { - msg (SW, _("TIME.HMS cannot mix positive and negative arguments.")); + msg_at (SW, expr_location (e, n), + _("TIME.HMS cannot accept a mix of positive and negative " + "arguments.")); + double args[] = { h, m, s }; + for (size_t i = 0; i < 3; i++) + if (args[i] > 0) + msg_at (SN, expr_location (e, n->args[i]), + _("This argument has positive value %g."), args[i]); + else if (args[i] < 0) + msg_at (SN, expr_location (e, n->args[i]), + _("This argument has negative value %g."), args[i]); return SYSMIS; } else @@ -288,13 +307,93 @@ function CTIME.MINUTES (time) = time / MIN_S; function CTIME.SECONDS (time) = time; // Date construction functions. -function DATE.DMY (d, m, y) = expr_ymd_to_date (y, m, d); -function DATE.MDY (m, d, y) = expr_ymd_to_date (y, m, d); -function DATE.MOYR (m, y) = expr_ymd_to_date (y, m, 1); -function DATE.QYR (q, y) = expr_ymd_to_date (y, q * 3 - 2, 1); -function DATE.WKYR (w, y) = expr_wkyr_to_date (w, y); -function DATE.YRDAY (y, yday) = expr_yrday_to_date (y, yday); -function YRMODA (y, m, d) = expr_yrmoda (y, m, d); +function DATE.DMY (integer d, integer m, integer y) + expression e; + expr_node n; += expr_ymd_to_date (y, m, d, e, n, 3, 2, 1); + +function DATE.MDY (integer m, integer d, integer y) + expression e; + expr_node n; += expr_ymd_to_date (y, m, d, e, n, 3, 1, 2); + +function DATE.MOYR (integer m, integer y) + expression e; + expr_node n; += expr_ymd_to_date (y, m, 1, e, n, 2, 1, 0); + +function DATE.QYR (integer q, integer y) + expression e; + expr_node n; +{ + if (q < 1 || q > 4) + { + msg_at (SW, expr_location (e, n->args[0]), + _("Argument 1 to DATE.QYR must be 1, 2, 3, or 4 (not %d)."), q); + return SYSMIS; + } + return expr_ymd_to_date (y, q * 3 - 2, 1, e, n, 2, 0, 0); +} + +function DATE.WKYR (integer w, integer y) + expression e; + expr_node n; +{ + if (w < 1 || w > 53) + { + msg_at (SE, expr_location (e, n->args[0]), + _("The week argument to DATE.WKYR is outside the acceptable " + "range of 1 to 53. The result will be system-missing.")); + return SYSMIS; + } + else + { + double yr_1_1 = expr_ymd_to_ofs (y, 1, 1, e, n, 2, 0, 0); + if (yr_1_1 != SYSMIS) + return DAY_S * (yr_1_1 + WEEK_DAY * (w - 1)); + else + return SYSMIS; + } +} + +function DATE.YRDAY (integer y, integer yd) + expression e; + expr_node n; +{ + if (yd < 1 || yd > 366) + { + msg_at (SE, expr_location (e, n->args[1]), + _("The value %d as day argument to DATE.YRDAY is outside the " + "acceptable range of 1 to 366. " + "The result will be system-missing."), yd); + return SYSMIS; + } + else + { + double yr_1_1 = expr_ymd_to_ofs (y, 1, 1, e, n, 1, 0, 0); + if (yr_1_1 != SYSMIS) + return DAY_S * (yr_1_1 + yd - 1.); + else + return SYSMIS; + } +} + +function YRMODA (integer y, integer m, integer d) + expression e; + expr_node n; +{ + if (y >= 0 && y <= 99) + y += 1900; + else if (y > 47516) + { + msg_at (SE, expr_location (e, n->args[0]), + _("The year argument to YRMODA is greater than 47516. " + "The result will be system-missing.")); + return SYSMIS; + } + + return expr_ymd_to_ofs (y, m, d, e, n, 1, 2, 3); +} // Date extraction functions. function XDATE.TDAY (date) = floor (date / DAY_S); @@ -317,11 +416,18 @@ function XDATE.YEAR (date >= DAY_S) = calendar_offset_to_year (date / DAY_S); // Date arithmetic functions. no_abbrev function DATEDIFF (date2 >= DAY_S, date1 >= DAY_S, string unit) - = expr_date_difference (date1, date2, unit); + expression e; + expr_node n; += expr_date_difference (date1, date2, unit, e, n); + no_abbrev function DATESUM (date, quantity, string unit) - = expr_date_sum (date, quantity, unit, ss_cstr ("closest")); + expression e; + expr_node n; += expr_date_sum_closest (date, quantity, unit, e, n); no_abbrev function DATESUM (date, quantity, string unit, string method) - = expr_date_sum (date, quantity, unit, method); + expression e; + expr_node n; += expr_date_sum (date, quantity, unit, method, e, n); // String functions. @@ -350,85 +456,83 @@ string function CONCAT (string a[n]) function INDEX (string haystack, string needle) { - if (needle.length == 0) - return SYSMIS; - else + if (haystack.length >= needle.length) { - int limit = haystack.length - needle.length + 1; - int i; - for (i = 1; i <= limit; i++) + size_t limit = haystack.length - needle.length + 1; + for (size_t i = 1; i <= limit; i++) if (!memcmp (&haystack.string[i - 1], needle.string, needle.length)) return i; - return 0; } + return 0; } -function INDEX (string haystack, string needles, needle_len_d) +function INDEX (string haystack, string needles, integer needle_len) + expression e; + expr_node n; { - if (needle_len_d <= INT_MIN || needle_len_d >= INT_MAX - || (int) needle_len_d != needle_len_d - || needles.length == 0) - return SYSMIS; - else + if (needle_len <= 0 || needles.length % needle_len != 0) { - int needle_len = needle_len_d; - if (needle_len < 0 || needle_len > needles.length - || needles.length % needle_len != 0) - return SYSMIS; - else - { - int limit = haystack.length - needle_len + 1; - int i, j; - for (i = 1; i <= limit; i++) - for (j = 0; j < needles.length; j += needle_len) - if (!memcmp (&haystack.string[i - 1], &needles.string[j], - needle_len)) - return i; - return 0; - } + msg_at (SE, expr_location (e, n), + _("INDEX needle length argument must evenly divide the " + "length of the needles argument.")); + msg_at (SN, expr_location (e, n->args[1]), + _("The needles argument has length %zu."), needles.length); + msg_at (SN, expr_location (e, n->args[2]), + _("The needle length argument has value %d."), needle_len); + return SYSMIS; + } + + if (haystack.length >= needle_len) + { + size_t limit = haystack.length - needle_len + 1; + for (size_t i = 1; i <= limit; i++) + for (size_t j = 0; j < needles.length; j += needle_len) + if (!memcmp (&haystack.string[i - 1], &needles.string[j], needle_len)) + return i; } -} + return 0; +} function RINDEX (string haystack, string needle) { - if (needle.length == 0) - return SYSMIS; - else + if (haystack.length >= needle.length) { - int limit = haystack.length - needle.length + 1; - int i; - for (i = limit; i >= 1; i--) + size_t limit = haystack.length - needle.length + 1; + for (size_t i = limit; i >= 1; i--) if (!memcmp (&haystack.string[i - 1], needle.string, needle.length)) return i; - return 0; } + + return 0; } -function RINDEX (string haystack, string needles, needle_len_d) +function RINDEX (string haystack, string needles, integer needle_len) + expression e; + expr_node n; { - if (needle_len_d <= INT_MIN || needle_len_d >= INT_MAX - || (int) needle_len_d != needle_len_d - || needles.length == 0) - return SYSMIS; - else + if (needle_len <= 0 || needles.length % needle_len != 0) { - int needle_len = needle_len_d; - if (needle_len < 0 || needle_len > needles.length - || needles.length % needle_len != 0) - return SYSMIS; - else - { - int limit = haystack.length - needle_len + 1; - int i, j; - for (i = limit; i >= 1; i--) - for (j = 0; j < needles.length; j += needle_len) - if (!memcmp (&haystack.string[i - 1], - &needles.string[j], needle_len)) - return i; - return 0; - } + msg_at (SE, expr_location (e, n), + _("RINDEX needle length argument must evenly divide the " + "length of the needles argument.")); + msg_at (SN, expr_location (e, n->args[1]), + _("The needles argument has length %zu."), needles.length); + msg_at (SN, expr_location (e, n->args[2]), + _("The needle length argument has value %d."), needle_len); + return SYSMIS; + } + + if (haystack.length >= needle_len) + { + size_t limit = haystack.length - needle_len + 1; + for (size_t i = limit; i >= 1; i--) + for (size_t j = 0; j < needles.length; j += needle_len) + if (!memcmp (&haystack.string[i - 1], &needles.string[j], needle_len)) + return i; } + + return 0; } function LENGTH (string s) @@ -462,73 +566,163 @@ string function UPCASE (string s) return s; } -absorb_miss string function LPAD (string s, n) +absorb_miss string function LPAD (string s, integer n) expression e; + expr_node node; { - if (n < 0 || n > MAX_STRING || (int) n != n) - return empty_string; + if (n < 0 || n > MAX_STRING) + { + if (n != INT_MIN) + { + msg_at (SE, expr_location (e, node), + _("The length argument to LPAD must be between 0 and %d."), + MAX_STRING); + msg_at (SN, expr_location (e, node->args[1]), + _("The length argument is %d."), n); + } + + return s; + } else if (s.length >= n) return s; else { struct substring t = alloc_string (e, n); - memset (t.string, ' ', n - s.length); - memcpy (&t.string[(int) n - s.length], s.string, s.length); + size_t pad = n - s.length; + memset (t.string, ' ', pad); + memcpy (&t.string[pad], s.string, s.length); return t; } } -absorb_miss string function LPAD (string s, n, string c) +absorb_miss string function LPAD (string s, integer n, string c) expression e; + expr_node node; { - if (n < 0 || n > MAX_STRING || (int) n != n || c.length != 1) - return empty_string; + if (n < 0 || n > MAX_STRING) + { + if (n != INT_MIN) + { + msg_at (SE, expr_location (e, node), + _("The length argument to LPAD must be between 0 and %d."), + MAX_STRING); + msg_at (SN, expr_location (e, node->args[1]), + _("The length argument is %d."), n); + } + + return s; + } else if (s.length >= n) return s; + else if (c.length == 0) + { + msg_at (SE, expr_location (e, node), + _("The padding argument to LPAD must not be an empty string.")); + return s; + } else { + size_t n_pad = (n - s.length) / c.length; + if (!n_pad) + return s; + struct substring t = alloc_string (e, n); - memset (t.string, c.string[0], n - s.length); - memcpy (&t.string[(int) n - s.length], s.string, s.length); + t.length = 0; + for (size_t i = 0; i < n_pad; i++) + { + memcpy (t.string + t.length, c.string, c.length); + t.length += c.length; + } + memcpy (t.string + t.length, s.string, s.length); + t.length += s.length; return t; } } -absorb_miss string function RPAD (string s, n) +string function REPLACE (string haystack, string needle, string replacement) + expression e; + = replace_string (e, haystack, needle, replacement, INT_MAX); + +absorb_miss string function REPLACE (string haystack, string needle, + string replacement, integer n) + expression e; + = replace_string (e, haystack, needle, replacement, n); + +absorb_miss string function RPAD (string s, integer n) expression e; + expr_node node; { - if (n < 0 || n > MAX_STRING || (int) n != n) - return empty_string; + if (n < 0 || n > MAX_STRING) + { + if (n != INT_MIN) + { + msg_at (SE, expr_location (e, node), + _("The length argument to RPAD must be between 0 and %d."), + MAX_STRING); + msg_at (SN, expr_location (e, node->args[1]), + _("The length argument is %d."), n); + } + + return s; + } else if (s.length >= n) return s; else { struct substring t = alloc_string (e, n); + size_t pad = n - s.length; memcpy (t.string, s.string, s.length); - memset (&t.string[s.length], ' ', n - s.length); + memset (t.string + s.length, ' ', pad); return t; } } -absorb_miss string function RPAD (string s, n, string c) +absorb_miss string function RPAD (string s, integer n, string c) expression e; + expr_node node; { - if (n < 0 || n > MAX_STRING || (int) n != n || c.length != 1) - return empty_string; + if (n < 0 || n > MAX_STRING) + { + if (n != INT_MIN) + { + msg_at (SE, expr_location (e, node), + _("The length argument to RPAD must be between 0 and %d."), + MAX_STRING); + msg_at (SN, expr_location (e, node->args[1]), + _("The length argument is %d."), n); + } + + return s; + } else if (s.length >= n) return s; + else if (c.length == 0) + { + msg_at (SE, expr_location (e, node), + _("The padding argument to RPAD must not be an empty string.")); + return s; + } else { + size_t n_pad = (n - s.length) / c.length; + if (!n_pad) + return s; + struct substring t = alloc_string (e, n); memcpy (t.string, s.string, s.length); - memset (&t.string[s.length], c.string[0], n - s.length); + t.length = s.length; + for (size_t i = 0; i < n_pad; i++) + { + memcpy (t.string + t.length, c.string, c.length); + t.length += c.length; + } return t; } } string function LTRIM (string s) { - while (s.length > 0 && s.string[0] == ' ') + while (s.length > 0 && s.string[0] == ' ') { s.length--; s.string++; @@ -538,17 +732,13 @@ string function LTRIM (string s) string function LTRIM (string s, string c) { - if (c.length == 1) - { - while (s.length > 0 && s.string[0] == c.string[0]) - { - s.length--; - s.string++; - } - return s; - } - else - return empty_string; + if (c.length > 0) + while (s.length >= c.length && !memcmp (s.string, c.string, c.length)) + { + s.length -= c.length; + s.string += c.length; + } + return s; } string function RTRIM (string s) @@ -560,20 +750,33 @@ string function RTRIM (string s) string function RTRIM (string s, string c) { - if (c.length == 1) - { - while (s.length > 0 && s.string[s.length - 1] == c.string[0]) - s.length--; - return s; - } - else - return empty_string; + if (c.length > 0) + while (s.length >= c.length + && !memcmp (&s.string[s.length - c.length], c.string, c.length)) + s.length -= c.length; + return s; } function NUMBER (string s, ni_format f) + expression e; + expr_node n; { + if (s.length > f->w) + s.length = f->w; + union value out; - data_in (ss_head (s, f->w), LEGACY_NATIVE, f->type, f->d, 0, 0, &out, 0); + char *error = data_in (s, C_ENCODING, f->type, settings_get_fmt_settings (), + &out, 0, NULL); + if (error == NULL) + data_in_imply_decimals (s, C_ENCODING, f->type, f->d, + settings_get_fmt_settings (), &out); + else + { + msg_at (SE, expr_location (e, n->args[0]), + _("Cannot parse \"%.*s\" as format %s: %s"), + (int) s.length, s.string, fmt_name (f->type), error); + free (error); + } return out.f; } @@ -587,34 +790,37 @@ absorb_miss string function STRING (x, no_format f) v.f = x; assert (!fmt_is_string (f->type)); - s = data_out (&v, "no-such-encoding", f); + s = data_out (&v, C_ENCODING, f, settings_get_fmt_settings ()); dst = alloc_string (e, strlen (s)); strcpy (dst.string, s); free (s); return dst; } -absorb_miss string function SUBSTR (string s, ofs) - expression e; +absorb_miss string function STRUNC (string s, integer n) { - if (ofs >= 1 && ofs <= s.length && (int) ofs == ofs) - return copy_string (e, &s.string[(int) ofs - 1], s.length - ofs + 1); - else - return empty_string; + if (n < 1) + return n == INT_MIN ? s : empty_string; + + if (n < s.length) + s.length = n; + while (s.length > 0 && s.string[s.length - 1] == ' ') + s.length--; + return s; } -absorb_miss string function SUBSTR (string s, ofs, cnt) - expression e; +absorb_miss string function SUBSTR (string s, integer ofs) { - if (ofs >= 1 && ofs <= s.length && (int) ofs == ofs - && cnt >= 1 && cnt <= INT_MAX && (int) cnt == cnt) - { - int cnt_max = s.length - (int) ofs + 1; - return copy_string (e, &s.string[(int) ofs - 1], - cnt <= cnt_max ? cnt : cnt_max); - } - else - return empty_string; + return (ofs >= 1 && ofs <= s.length + ? ss_substr (s, ofs - 1, SIZE_MAX) + : empty_string); +} + +absorb_miss string function SUBSTR (string s, integer ofs, integer len) +{ + return (ofs >= 1 && len >= 1 + ? ss_substr (s, ofs - 1, len) + : empty_string); } absorb_miss no_opt no_abbrev string function VALUELABEL (var v) @@ -630,18 +836,61 @@ absorb_miss no_opt no_abbrev string function VALUELABEL (var v) // Artificial. operator SQUARE (x) = x * x; -boolean operator NUM_TO_BOOLEAN (x) + +absorb_miss boolean operator OPERAND_TO_BOOLEAN (x, expr_node parent) + expression e; + expr_node n; { if (x == 0. || x == 1. || x == SYSMIS) return x; - else + + switch (parent->n_args) { - msg (SE, _("A number being treated as a Boolean in an " - "expression was found to have a value other than " - "0 (false), 1 (true), or the system-missing value. " - "The result was forced to 0.")); - return 0.; + case 2: + msg_at (SE, expr_location (e, parent), + /* TRANSLATORS: There are exactly two operands. */ + _("The operands of %s must have value 0 or 1."), + operations[parent->type].name); + break; + + case 1: + msg_at (SE, expr_location (e, parent), + _("The operand of %s must have value 0 or 1."), + operations[parent->type].name); + break; + + default: + NOT_REACHED (); } + + msg_at (SN, expr_location (e, n), + _("This operand with unexpected value %g will be treated as 0."), x); + return 0.; +} + +absorb_miss boolean operator EXPR_TO_BOOLEAN (x) + expression e; + expr_node n; +{ + if (x == 0. || x == 1. || x == SYSMIS) + return x; + + msg_at (SE, expr_location (e, n), + _("This expression, which must be 0 or 1, evaluated to %g. " + "It will be treated as 0."), x); + return 0.; +} + +operator NUM_TO_INTEGER (x) + expression e; + expr_node n; +{ + if (x == floor (x) && x > INT_MIN && x <= INT_MAX) + return x; + + msg_at (SE, expr_location (e, n), + _("Treating unexpected non-integer value %g as missing."), x); + return SYSMIS; } operator BOOLEAN_TO_NUM (boolean x) = x; @@ -706,7 +955,7 @@ function CDF.GAMMA (x >= 0, a > 0, b > 0) = gsl_cdf_gamma_P (x, a, 1. / b); function IDF.GAMMA (P >= 0 && P <= 1, a > 0, b > 0) = gsl_cdf_gamma_Pinv (P, a, 1. / b); function PDF.GAMMA (x >= 0, a > 0, b > 0) = gsl_ran_gamma_pdf (x, a, 1. / b); -no_opt function RV.GAMMA (a > 0, b > 0) +no_opt function RV.GAMMA (a > 0, b > 0) = gsl_ran_gamma (get_rng (), a, 1. / b); // Half-normal distribution. @@ -730,16 +979,16 @@ function CDF.LAPLACE (x, a, b > 0) = gsl_cdf_laplace_P ((x - a) / b, 1); function IDF.LAPLACE (P > 0 && P < 1, a, b > 0) = a + b * gsl_cdf_laplace_Pinv (P, 1); function PDF.LAPLACE (x, a, b > 0) = gsl_ran_laplace_pdf ((x - a) / b, 1) / b; -no_opt function RV.LAPLACE (a, b > 0) +no_opt function RV.LAPLACE (a, b > 0) = a + b * gsl_ran_laplace (get_rng (), 1); // Levy alpha-stable distribution. -no_opt extension function RV.LEVY (c, alpha > 0 && alpha <= 2) +no_opt extension function RV.LEVY (c, alpha > 0 && alpha <= 2) = gsl_ran_levy (get_rng (), c, alpha); // Levy skew alpha-stable distribution. no_opt extension function RV.LVSKEW (c, alpha > 0 && alpha <= 2, - beta >= -1 && beta <= 1) + beta >= -1 && beta <= 1) = gsl_ran_levy_skew (get_rng (), c, alpha, beta); // Logistic distribution. @@ -748,7 +997,7 @@ function IDF.LOGISTIC (P > 0 && P < 1, a, b > 0) = a + b * gsl_cdf_logistic_Pinv (P, 1); function PDF.LOGISTIC (x, a, b > 0) = gsl_ran_logistic_pdf ((x - a) / b, 1) / b; -no_opt function RV.LOGISTIC (a, b > 0) +no_opt function RV.LOGISTIC (a, b > 0) = a + b * gsl_ran_logistic (get_rng (), 1); // Lognormal distribution. @@ -758,7 +1007,7 @@ function IDF.LNORMAL (P >= 0 && P < 1, m > 0, s > 0) = gsl_cdf_lognormal_Pinv (P, log (m), s); function PDF.LNORMAL (x >= 0, m > 0, s > 0) = gsl_ran_lognormal_pdf (x, log (m), s); -no_opt function RV.LNORMAL (m > 0, s > 0) +no_opt function RV.LNORMAL (m > 0, s > 0) = gsl_ran_lognormal (get_rng (), log (m), s); // Normal distribution. @@ -774,7 +1023,7 @@ no_opt function NORMAL (s > 0) = gsl_ran_gaussian (get_rng (), s); // Normal tail distribution. function PDF.NTAIL (x, a > 0, sigma > 0) = gsl_ran_gaussian_tail_pdf (x, a, sigma); -no_opt function RV.NTAIL (a > 0, sigma > 0) +no_opt function RV.NTAIL (a > 0, sigma > 0) = gsl_ran_gaussian_tail (get_rng (), a, sigma); // Pareto distribution. @@ -790,13 +1039,13 @@ extension function IDF.RAYLEIGH (P >= 0 && P <= 1, sigma > 0) = gsl_cdf_rayleigh_Pinv (P, sigma); extension function PDF.RAYLEIGH (x, sigma > 0) = gsl_ran_rayleigh_pdf (x, sigma); -no_opt extension function RV.RAYLEIGH (sigma > 0) +no_opt extension function RV.RAYLEIGH (sigma > 0) = gsl_ran_rayleigh (get_rng (), sigma); // Rayleigh tail distribution. extension function PDF.RTAIL (x, a, sigma) = gsl_ran_rayleigh_tail_pdf (x, a, sigma); -no_opt extension function RV.RTAIL (a, sigma) +no_opt extension function RV.RTAIL (a, sigma) = gsl_ran_rayleigh_tail (get_rng (), a, sigma); // Studentized maximum modulus distribution. @@ -818,14 +1067,14 @@ function NPDF.T (x, df > 0, nc) = unimplemented; // Type-1 Gumbel distribution. extension function CDF.T1G (x, a, b) = gsl_cdf_gumbel1_P (x, a, b); extension function IDF.T1G (P >= 0 && P <= 1, a, b) - = gsl_cdf_gumbel1_P (P, a, b); + = gsl_cdf_gumbel1_Pinv (P, a, b); extension function PDF.T1G (x, a, b) = gsl_ran_gumbel1_pdf (x, a, b); no_opt extension function RV.T1G (a, b) = gsl_ran_gumbel1 (get_rng (), a, b); // Type-2 Gumbel distribution. extension function CDF.T2G (x, a, b) = gsl_cdf_gumbel2_P (x, a, b); extension function IDF.T2G (P >= 0 && P <= 1, a, b) - = gsl_cdf_gumbel2_P (P, a, b); + = gsl_cdf_gumbel2_Pinv (P, a, b); extension function PDF.T2G (x, a, b) = gsl_ran_gumbel2_pdf (x, a, b); no_opt extension function RV.T2G (a, b) = gsl_ran_gumbel2 (get_rng (), a, b); @@ -845,11 +1094,11 @@ function PDF.WEIBULL (x >= 0, a > 0, b > 0) = gsl_ran_weibull_pdf (x, a, b); no_opt function RV.WEIBULL (a > 0, b > 0) = gsl_ran_weibull (get_rng (), a, b); // Bernoulli distribution. -function CDF.BERNOULLI (k == 0 || k == 1, p >= 0 && p <= 1) +function CDF.BERNOULLI (k == 0 || k == 1, p >= 0 && p <= 1) = k ? 1 : 1 - p; function PDF.BERNOULLI (k == 0 || k == 1, p >= 0 && p <= 1) = gsl_ran_bernoulli_pdf (k, p); -no_opt function RV.BERNOULLI (p >= 0 && p <= 1) +no_opt function RV.BERNOULLI (p >= 0 && p <= 1) = gsl_ran_bernoulli (get_rng (), p); // Binomial distribution. @@ -859,7 +1108,7 @@ function PDF.BINOM (k >= 0 && k == floor (k) && k <= n, n > 0 && n == floor (n), p >= 0 && p <= 1) = gsl_ran_binomial_pdf (k, p, n); -no_opt function RV.BINOM (p > 0 && p == floor (p), n >= 0 && n <= 1) +no_opt function RV.BINOM (p > 0 && p == floor (p), n >= 0 && n <= 1) = gsl_ran_binomial (get_rng (), p, n); // Geometric distribution. @@ -889,7 +1138,7 @@ no_opt function RV.HYPER (a > 0 && a == floor (a), // Logarithmic distribution. extension function PDF.LOG (k >= 1, p > 0 && p <= 1) = gsl_ran_logarithmic_pdf (k, p); -no_opt extension function RV.LOG (p > 0 && p <= 1) +no_opt extension function RV.LOG (p > 0 && p <= 1) = gsl_ran_logarithmic (get_rng (), p); // Negative binomial distribution. @@ -897,7 +1146,7 @@ function CDF.NEGBIN (k >= 1, n == floor (n), p > 0 && p <= 1) = gsl_cdf_negative_binomial_P (k, p, n); function PDF.NEGBIN (k >= 1, n == floor (n), p > 0 && p <= 1) = gsl_ran_negative_binomial_pdf (k, p, n); -no_opt function RV.NEGBIN (n == floor (n), p > 0 && p <= 1) +no_opt function RV.NEGBIN (n == floor (n), p > 0 && p <= 1) = gsl_ran_negative_binomial (get_rng (), p, n); // Poisson distribution. @@ -908,65 +1157,67 @@ function PDF.POISSON (k >= 0 && k == floor (k), mu > 0) no_opt function RV.POISSON (mu > 0) = gsl_ran_poisson (get_rng (), mu); // Weirdness. -absorb_miss boolean function MISSING (x) = x == SYSMIS || !finite (x); -absorb_miss boolean function SYSMIS (x) = x == SYSMIS || !finite (x); +absorb_miss boolean function MISSING (x) = x == SYSMIS || !isfinite (x); +absorb_miss boolean function SYSMIS (x) = x == SYSMIS || !isfinite (x); no_opt boolean function SYSMIS (num_var v) case c; { return case_num (c, v) == SYSMIS; } -no_opt boolean function VALUE (num_var v) +no_opt function VALUE (num_var v) case c; { return case_num (c, v); } +no_opt function VALUE (num_vec_elem v) +{ + return v; +} -no_opt operator VEC_ELEM_NUM (idx) +// A numeric vector element used in a "normal" context, in which a user-missing +// value becomes system-missing. +absorb_miss no_opt operator VEC_ELEM_NUM (idx) vector v; case c; + expression e; + expr_node n; { - if (idx >= 1 && idx <= vector_get_var_cnt (v)) + const struct variable *var = expr_index_vector (e, n, v, idx); + if (var) { - const struct variable *var = vector_get_var (v, (size_t) idx - 1); - double value = case_num (c, var); - return !var_is_num_missing (var, value, MV_USER) ? value : SYSMIS; - } - else - { - if (idx == SYSMIS) - msg (SE, _("SYSMIS is not a valid index value for vector " - "%s. The result will be set to SYSMIS."), - vector_get_name (v)); - else - msg (SE, _("%g is not a valid index value for vector %s. " - "The result will be set to SYSMIS."), - idx, vector_get_name (v)); - return SYSMIS; + double d = case_num (c, var); + if (var_is_num_missing (var, d) != MV_USER) + return d; } + return SYSMIS; +} + +// A numeric vector element used as the argument to the VALUE() function, in +// which a user-missing value retains its value. +// +// All numeric vector elements are initially parsed this way. In most contexts +// they then get coerced into numbers. +absorb_miss no_opt num_vec_elem operator VEC_ELEM_NUM_RAW (idx) + vector v; + case c; + expression e; + expr_node n; +{ + const struct variable *var = expr_index_vector (e, n, v, idx); + return var ? case_num (c, var) : SYSMIS; } absorb_miss no_opt string operator VEC_ELEM_STR (idx) expression e; vector v; case c; + expr_node n; { - if (idx >= 1 && idx <= vector_get_var_cnt (v)) - { - struct variable *var = vector_get_var (v, (size_t) idx - 1); - return copy_string (e, case_str (c, var), var_get_width (var)); - } - else - { - if (idx == SYSMIS) - msg (SE, _("SYSMIS is not a valid index value for vector " - "%s. The result will be set to the empty string."), - vector_get_name (v)); - else - msg (SE, _("%g is not a valid index value for vector %s. " - "The result will be set to the empty string."), - idx, vector_get_name (v)); - return empty_string; - } + const struct variable *var = expr_index_vector (e, n, v, idx); + return (var + ? copy_string (e, CHAR_CAST_BUG (char *, case_str (c, var)), + var_get_width (var)) + : empty_string); } // Terminals. @@ -976,7 +1227,7 @@ no_opt operator NUM_VAR () num_var v; { double d = case_num (c, v); - return !var_is_num_missing (v, d, MV_USER) ? d : SYSMIS; + return var_is_num_missing (v, d) ? SYSMIS : d; } no_opt string operator STR_VAR () @@ -996,7 +1247,7 @@ no_opt perm_only function LAG (num_var v, pos_int n_before) if (c != NULL) { double x = case_num (c, v); - return !var_is_num_missing (v, x, MV_USER) ? x : SYSMIS; + return var_is_num_missing (v, x) ? SYSMIS : x; } else return SYSMIS; @@ -1009,7 +1260,7 @@ no_opt perm_only function LAG (num_var v) if (c != NULL) { double x = case_num (c, v); - return !var_is_num_missing (v, x, MV_USER) ? x : SYSMIS; + return var_is_num_missing (v, x) ? SYSMIS : x; } else return SYSMIS; @@ -1021,7 +1272,8 @@ no_opt perm_only string function LAG (str_var v, pos_int n_before) { const struct ccase *c = lagged_case (ds, n_before); if (c != NULL) - return copy_string (e, case_str (c, v), var_get_width (v)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)), + var_get_width (v)); else return empty_string; } @@ -1032,7 +1284,8 @@ no_opt perm_only string function LAG (str_var v) { const struct ccase *c = lagged_case (ds, 1); if (c != NULL) - return copy_string (e, case_str (c, v), var_get_width (v)); + return copy_string (e, CHAR_CAST_BUG (char *, case_str (c, v)), + var_get_width (v)); else return empty_string; }