comparison src/mono_opt.sml @ 2304:6fb9232ade99

Merge Sqlcache
author Adam Chlipala <adam@chlipala.net>
date Sun, 20 Dec 2015 14:18:52 -0500
parents 8428c534913a
children
comparison
equal deleted inserted replaced
2201:1091227f535a 2304:6fb9232ade99
14 * 14 *
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
167 167
168 | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2)) 168 | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2))
169 169
170 | EStrcat (e1, (EPrim (Prim.String (_, "")), _)) => #1 e1 170 | EStrcat (e1, (EPrim (Prim.String (_, "")), _)) => #1 e1
171 | EStrcat ((EPrim (Prim.String (_, "")), _), e2) => #1 e2 171 | EStrcat ((EPrim (Prim.String (_, "")), _), e2) => #1 e2
172 172
173 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) => 173 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EPrim (Prim.String (Prim.Html, s2)), _)) =>
174 let 174 let
175 val s = 175 val s =
176 if size s1 > 0 andalso size s2 > 0 176 if size s1 > 0 andalso size s2 > 0
177 andalso Char.isSpace (String.sub (s1, size s1 - 1)) 177 andalso Char.isSpace (String.sub (s1, size s1 - 1))
180 else 180 else
181 s1 ^ s2 181 s1 ^ s2
182 in 182 in
183 EPrim (Prim.String (Prim.Html, s)) 183 EPrim (Prim.String (Prim.Html, s))
184 end 184 end
185 185
186 | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) => 186 | EStrcat ((EPrim (Prim.String (_, s1)), loc), (EPrim (Prim.String (_, s2)), _)) =>
187 EPrim (Prim.String (Prim.Normal, s1 ^ s2)) 187 EPrim (Prim.String (Prim.Normal, s1 ^ s2))
188 188
189 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) => 189 | EStrcat ((EPrim (Prim.String (Prim.Html, s1)), loc), (EStrcat ((EPrim (Prim.String (Prim.Html, s2)), _), rest), _)) =>
190 let 190 let
538 (if Settings.checkEnvVar s then 538 (if Settings.checkEnvVar s then
539 ESome ((TFfi ("Basis", "string"), loc), (se, loc)) 539 ESome ((TFfi ("Basis", "string"), loc), (se, loc))
540 else 540 else
541 ENone (TFfi ("Basis", "string"), loc)) 541 ENone (TFfi ("Basis", "string"), loc))
542 542
543 | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) => 543 | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String (_, s)), loc), _)]) =>
544 let 544 let
545 fun uwify (cs, acc) = 545 fun uwify (cs, acc) =
546 case cs of 546 case cs of
547 [] => String.concat (rev acc) 547 [] => String.concat (rev acc)
548 | #"(" :: #"_" :: cs => uwify (cs, "(uw_" :: acc) 548 | #"(" :: #"_" :: cs => uwify (cs, "(uw_" :: acc)
566 | cs => uwify (cs, []) 566 | cs => uwify (cs, [])
567 in 567 in
568 EPrim (Prim.String (Prim.Normal, s)) 568 EPrim (Prim.String (Prim.Normal, s))
569 end 569 end
570 570
571 | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) => 571 | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String (_, s)), loc), _)]) =>
572 let 572 let
573 fun uwify (cs, acc) = 573 fun uwify (cs, acc) =
574 case cs of 574 case cs of
575 [] => String.concat (rev acc) 575 [] => String.concat (rev acc)
576 | #"A" :: #"S" :: #" " :: #"_" :: cs => uwify (cs, "AS uw_" :: acc) 576 | #"A" :: #"S" :: #" " :: #"_" :: cs => uwify (cs, "AS uw_" :: acc)
591 val s = uwify (String.explode s, []) 591 val s = uwify (String.explode s, [])
592 in 592 in
593 EPrim (Prim.String (Prim.Normal, s)) 593 EPrim (Prim.String (Prim.Normal, s))
594 end 594 end
595 595
596 | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) => 596 | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String (_, s)), _), _)]) =>
597 EPrim (Prim.String (Prim.Normal, unAs s)) 597 EPrim (Prim.String (Prim.Normal, unAs s))
598 | EFfiApp ("Basis", "unAs", [(e', _)]) => 598 | EFfiApp ("Basis", "unAs", [(e', _)]) =>
599 let 599 let
600 fun parts (e as (_, loc)) = 600 fun parts (e as (_, loc)) =
601 case #1 e of 601 case #1 e of