1 //: Extend 'new' to handle a unicode string literal argument or 'text'.
  2 
  3 //: A Mu text is an address to an array of characters.
  4 :(before "End Mu Types Initialization")
  5 put(Type_abbreviations, "text", new_type_tree("address:array:character"));
  6 
  7 :(scenario new_string)
  8 def main [
  9   1:text <- new [abc def]
 10   2:char <- index *1:text, 5
 11 ]
 12 # number code for 'e'
 13 +mem: storing 101 in location 2
 14 
 15 :(scenario new_string_handles_unicode)
 16 def main [
 17   1:text <- new [a«c]
 18   2:num <- length *1:text
 19   3:char <- index *1:text, 1
 20 ]
 21 +mem: storing 3 in location 2
 22 # unicode for '«'
 23 +mem: storing 171 in location 3
 24 
 25 :(before "End NEW Check Special-cases")
 26 if (is_literal_text(inst.ingredients.at(0))) break;
 27 :(before "Convert 'new' To 'allocate'")
 28 if (inst.name == "new" && !inst.ingredients.empty() && is_literal_text(inst.ingredients.at(0))) continue;
 29 :(after "case NEW" following "Primitive Recipe Implementations")
 30   if (is_literal_text(current_instruction().ingredients.at(0))) {
 31     products.resize(1);
 32     products.at(0).push_back(new_mu_text(current_instruction().ingredients.at(0).name));
 33     trace("mem") << "new string alloc: " << products.at(0).at(0) << end();
 34     break;
 35   }
 36 
 37 :(code)
 38 int new_mu_text(const string& contents) {
 39   // allocate an array just large enough for it
 40   int string_length = unicode_length(contents);
 41 //?   Total_alloc += string_length+1;
 42 //?   ++Num_alloc;
 43   int result = allocate(string_length+/*array length*/1);
 44   int curr_address = result;
 45   trace("mem") << "storing string length " << string_length << " in location " << curr_address << end();
 46   put(Memory, curr_address, string_length);
 47   ++curr_address;  // skip length
 48   int curr = 0;
 49   const char* raw_contents = contents.c_str();
 50   for (int i = 0;  i < string_length;  ++i) {
 51     uint32_t curr_character;
 52     assert(curr < SIZE(contents));
 53     tb_utf8_char_to_unicode(&curr_character, &raw_contents[curr]);
 54     trace("mem") << "storing string character " << curr_character << " in location " << curr_address << end();
 55     put(Memory, curr_address, curr_character);
 56     curr += tb_utf8_char_length(raw_contents[curr]);
 57     ++curr_address;
 58   }
 59   // Mu strings are not null-terminated in memory.
 60   return result;
 61 }
 62 
 63 //: a new kind of typo
 64 
 65 :(scenario string_literal_without_instruction)
 66 % Hide_errors = true;
 67 def main [
 68   [abc]
 69 ]
 70 +error: main: instruction '[abc]' has no recipe in '[abc]'
 71 
 72 //: stash recognizes strings
 73 
 74 :(scenario stash_string)
 75 def main [
 76   1:text <- new [abc]
 77   stash [foo:], 1:text
 78 ]
 79 +app: foo: abc
 80 
 81 :(before "End inspect Special-cases(r, data)")
 82 if (is_mu_text(r)) {
 83   assert(scalar(data));
 84   return read_mu_text(data.at(0));
 85 }
 86 
 87 :(before "End $print Special-cases")
 88 else if (is_mu_text(current_instruction().ingredients.at(i))) {
 89   cout << read_mu_text(ingredients.at(i).at(0));
 90 }
 91 
 92 :(scenario unicode_string)
 93 def main [
 94   1:text <- new [♠]
 95   stash [foo:], 1:text
 96 ]
 97 +app: foo: ♠
 98 
 99 :(scenario stash_space_after_string)
100 def main [
101   1:text <- new [abc]
102   stash 1:text, [foo]
103 ]
104 +app: abc foo
105 
106 :(scenario stash_string_as_array)
107 def main [
108   1:text <- new [abc]
109   stash *1:text
110 ]
111 +app: 3 97 98 99
112 
113 //: fixes way more than just stash
114 :(before "End Preprocess is_mu_text(reagent x)")
115 if (!canonize_type(x)) return false;
116 
117 //: Allocate more to routine when initializing a literal string
118 :(scenario new_string_overflow)
119 % Initial_memory_per_routine = 2;
120 def main [
121   1:address:num/raw <- new number:type
122   2:text/raw <- new [a]  # not enough room in initial page, if you take the array length into account
123 ]
124 +new: routine allocated memory from 1000 to 1002
125 +new: routine allocated memory from 1002 to 1004
126 
127 //: helpers
128 :(code)
129 int unicode_length(const string& s) {
130   const char* in = s.c_str();
131   int result = 0;
132   int curr = 0;
133   while (curr < SIZE(s)) {  // carefully bounds-check on the string
134     // before accessing its raw pointer
135     ++result;
136     curr += tb_utf8_char_length(in[curr]);
137   }
138   return result;
139 }
140 
141 string read_mu_text(int address) {
142   if (address == 0) return "";
143   int length = get_or_insert(Memory, address);
144   if (length == 0) return "";
145   return read_mu_characters(address+1, length);
146 }
147 
148 string read_mu_characters(int start, int length) {
149   ostringstream tmp;
150   for (int curr = start;  curr < start+length;  ++curr)
151     tmp << to_unicode(static_cast<uint32_t>(get_or_insert(Memory, curr)));
152   return tmp.str();
153 }
154 
155 //:: some miscellaneous helpers now that we have text
156 
157 //: assert: perform sanity checks at runtime
158 
159 :(scenario assert)
160 % Hide_errors = true;  // '%' lines insert arbitrary C code into tests before calling 'run' with the lines below. Must be immediately after :(scenario) line.
161 def main [
162   assert 0, [this is an assert in Mu]
163 ]
164 +error: this is an assert in Mu
165 
166 :(before "End Primitive Recipe Declarations")
167 ASSERT,
168 :(before "End Primitive Recipe Numbers")
169 put(Recipe_ordinal, "assert", ASSERT);
170 :(before "End Primitive Recipe Checks")
171 case ASSERT: {
172   if (SIZE(inst.ingredients) != 2) {
173     raise << maybe(get(Recipe, r).name) << "'assert' takes exactly two ingredients rather than '" << to_original_string(inst) << "'\n" << end();
174     break;
175   }
176   if (!is_mu_scalar(inst.ingredients.at(0))) {
177     raise << maybe(get(Recipe, r).name) << "'assert' requires a boolean for its first ingredient, but got '" << inst.ingredients.at(0).original_string << "'\n" << end();
178     break;
179   }
180   if (!is_literal_text(inst.ingredients.at(1)) && !is_mu_text(inst.ingredients.at(1))) {
181     raise << maybe(get(Recipe, r).name) << "'assert' requires a text as its second ingredient, but got '" << inst.ingredients.at(1).original_string << "'\n" << end();
182     break;
183   }
184   break;
185 }
186 :(before "End Primitive Recipe Implementations")
187 case ASSERT: {
188   if (!ingredients.at(0).at(0)) {
189     if (is_literal_text(current_instruction().ingredients.at(1)))
190       raise << current_instruction().ingredients.at(1).name << '\n' << end();
191     else
192       raise << read_mu_text(ingredients.at(1).at(0)) << '\n' << end();
193     if (!Hide_errors) exit(1);
194   }
195   break;
196 }
197 
198 //: 'cheating' by using the host system
199 
200 :(before "End Primitive Recipe Declarations")
201 _READ,
202 :(before "End Primitive Recipe Numbers")
203 put(Recipe_ordinal, "$read", _READ);
204 :(before "End Primitive Recipe Checks")
205 case _READ: {
206   break;
207 }
208 :(before "End Primitive Recipe Implementations")
209 case _READ: {
210   skip_whitespace(cin);
211   string result;
212   if (has_data(cin))
213     cin >> result;
214   products.resize(1);
215   products.at(0).push_back(new_mu_text(result));
216   break;
217 }
218 
219 :(code)
220 void skip_whitespace(istream& in) {
221   while (true) {
222     if (!has_data(in)) break;
223     if (isspace(in.peek())) in.get();
224     else break;
225   }
226 }