ref: 52b1309ae4cf31a5aa4bed01e5dcee492ebd645e
parent: 3a29356d120d0a22a1ae327cad2ee55766e82608
author: Rewbert <krookr@chalmers.se>
date: Mon Sep 25 10:02:20 EDT 2023
fix Lennarts comments
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.5
922
-(($A :0 _807) (($A :1 (($B _853) _0)) (($A :2 ((($S' _853) _0) $I)) (($A :3 _777) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _806) (($C _69) _5))) (($A :7 ((($C' _6) (_824 _66)) ((_69 _822) _65))) (($A :8 (($B (($S _853) _822)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_69 _181)) _10)) (($A :12 (($B ($B (_68 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_68 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_68 _9)) $P)) (($A :15 (($B ($B (_68 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_68 _9)) ($B ($P _736)))) (($A :18 (($B (_68 _9)) ($BK ($P _736)))) (($A :19 ((_68 _9) (($S $P) $I))) (($A :20 (($B (_68 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _109)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _110)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _736)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _736))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _782) (($A :34 _783) (($A :35 ((($S' _26) (_774 97)) (($C _774) 122))) (($A :36 ((($S' _26) (_774 65)) (($C _774) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_774 48)) (($C _774) 57))) (($A :39 ((($S' _26) (_774 32)) (($C _774) 126))) (($A :40 _771) (($A :41 _772) (($A :42 _774) (($A :43 _773) (($A :44 ((($S' _25) (($C _40) 32)) ((($S' _25) (($C _40) 9)) (($C _40) 10)))) (($A :45 _743) (($A :46 _744) (($A :47 _745) (($A :48 (_46 f0.0)) (($A :49 _45) (($A :50 _46) (($A :51 _47) (($A :52 _746) (($A :53 _747) (($A :54 _52) (($A :55 _53) (($A :56 _748) (($A :57 _749) (($A :58 _750) (($A :59 _751) (($A :60 _56) (($A :61 _57) (($A :62 _58) (($A :63 _59) (($A :64 _752) (($A :65 (($B $BK) $T)) (($A :66 ($BK $T)) (($A :67 $P) (($A :68 $I) (($A :69 $B) (($A :70 $I) (($A :71 $K) (($A :72 $C) (($A :73 _778) (($A :74 (($C (($C $S') _181)) _182)) (($A :75 ((($C' ($S' ($C' $B))) $B) $I)) (($A :76 _737) (($A :77 _738) (($A :78 _739) (($A :79 _740) (($A :80 _741) (($A :81 _742) (($A :82 (_77 0)) (($A :83 _759) (($A :84 _760) (($A :85 _761) (($A :86 _762) (($A :87 _763) (($A :88 _764) (($A :89 _83) (($A :90 ($BK $K)) (($A :91 (($B $BK) (($B ($B $BK)) $P))) (($A :92 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :93 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_86 0))) (_83 0)))) (($B ($B (($C' $P) (_81 1)))) _76))) ($C $P))) _79)) _80)) (($A :94 _90) (($A :95 ((($S' $C) (($B ($P _170)) ((($C' ($C' $B)) ((($C' $C) _83) _170)) _171))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_83 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_83 1)))) (($B (($C' $C) (($B (($C' $S') (_83 2))) ($C _95)))) ($C _95))))) ($C _95))))) ($C _95)))) ($T $K))) ($T $A)))) (($C _93) 4)))) (($A :96 (_102 _71)) (($A :97 ((_117 (_74 _96)) _94)) (($A :98 (($C ((($C' $B) (($P _109) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _99)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _99))) ((($S' ($C' $B)) (($B ($B _99)) ((($C' $B) (($B _115) ($T 0))) _98))) ((($C' $B) (($B _115) ($T 1))) _98)))) ((($C' $B) (($B _115) ($T 2))) _98)))) ((($C' $B) (($B _115) ($T 3))) _98)))) (($B $T) (($B ($B $P)) (($C' _76) (_78 4)))))) (($A :99 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _85)))) (($B (($C' $B) _110)) _99)))))) (($B (($C' $B) _110)) ($C _99)))))))))) (((_735 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :100 ((_69 (_115 _181)) _98)) (($A :101 ((($C' $C) ((($C' $C) ($C _95)) (_3 "Data.IntMap.!"))) $I)) (($A :102 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($
\ No newline at end of file
+(($A :0 _807) (($A :1 (($B _853) _0)) (($A :2 ((($S' _853) _0) $I)) (($A :3 _777) (($A :4 (_3 "undefined")) (($A :5 $I) (($A :6 ((($C' $B) _806) (($C _69) _5))) (($A :7 ((($C' _6) (_824 _66)) ((_69 _822) _65))) (($A :8 (($B (($S _853) _822)) _3)) (($A :9 $T) (($A :10 ($T $I)) (($A :11 (($B (_69 _181)) _10)) (($A :12 (($B ($B (_68 _9))) ((($C' $B) (($B $C) _10)) ($B _10)))) (($A :13 (($B ($B (_68 _9))) ((($C' $B) (($B $C) _10)) ($BK _10)))) (($A :14 (($B (_68 _9)) $P)) (($A :15 (($B ($B (_68 _9))) (($B (($C' $C) _10)) ($B $P)))) (($A :16 _15) (($A :17 (($B (_68 _9)) ($B ($P _736)))) (($A :18 (($B (_68 _9)) ($BK ($P _736)))) (($A :19 ((_68 _9) (($S $P) $I))) (($A :20 (($B (_68 _9)) (($C ($S' $P)) $I))) (($A :21 (($B $Y) (($B ($B ($P (_14 _109)))) ((($C' $B) (($B ($C' $B)) ($B _12))) ((($C' ($C' $B)) ($B _12)) (($B ($B _14)) _110)))))) (($A :22 (($B $Y) (($B ($B ($P (_14 _736)))) (($B ($C' $B)) ($B _13))))) (($A :23 _3) (($A :24 ($T (_14 _736))) (($A :25 (($C $C) _32)) (($A :26 ($T _31)) (($A :27 (($P _32) _31)) (($A :28 _32) (($A :29 (($C (($C $S') _27)) $I)) (($A :30 (($C $S) _27)) (($A :31 $K) (($A :32 $A) (($A :33 _782) (($A :34 _783) (($A :35 ((($S' _26) (_774 97)) (($C _774) 122))) (($A :36 ((($S' _26) (_774 65)) (($C _774) 90))) (($A :37 ((($S' _25) _35) _36)) (($A :38 ((($S' _26) (_774 48)) (($C _774) 57))) (($A :39 ((($S' _26) (_774 32)) (($C _774) 126))) (($A :40 _771) (($A :41 _772) (($A :42 _774) (($A :43 _773) (($A :44 ((($S' _25) (($C _40) 32)) ((($S' _25) (($C _40) 9)) (($C _40) 10)))) (($A :45 _743) (($A :46 _744) (($A :47 _745) (($A :48 (_46 %0.0)) (($A :49 _45) (($A :50 _46) (($A :51 _47) (($A :52 _746) (($A :53 _747) (($A :54 _52) (($A :55 _53) (($A :56 _748) (($A :57 _749) (($A :58 _750) (($A :59 _751) (($A :60 _56) (($A :61 _57) (($A :62 _58) (($A :63 _59) (($A :64 _752) (($A :65 (($B $BK) $T)) (($A :66 ($BK $T)) (($A :67 $P) (($A :68 $I) (($A :69 $B) (($A :70 $I) (($A :71 $K) (($A :72 $C) (($A :73 _778) (($A :74 (($C (($C $S') _181)) _182)) (($A :75 ((($C' ($S' ($C' $B))) $B) $I)) (($A :76 _737) (($A :77 _738) (($A :78 _739) (($A :79 _740) (($A :80 _741) (($A :81 _742) (($A :82 (_77 0)) (($A :83 _759) (($A :84 _760) (($A :85 _761) (($A :86 _762) (($A :87 _763) (($A :88 _764) (($A :89 _83) (($A :90 ($BK $K)) (($A :91 (($B $BK) (($B ($B $BK)) $P))) (($A :92 (($B ($B ($B $BK))) (($B ($B ($B $BK))) (($B ($B ($B $C))) (($B ($B $C)) $P))))) (($A :93 ((($S' $S) ((($S' ($S' $C)) ((($C' ($C' $S)) ((($C' $B) (($B ($S' $S')) ((($C' $B) (($B _25) (_86 0))) (_83 0)))) (($B ($B (($C' $P) (_81 1)))) _76))) ($C $P))) _79)) _80)) (($A :94 _90) (($A :95 ((($S' $C) (($B ($P _170)) ((($C' ($C' $B)) ((($C' $C) _83) _170)) _171))) (($B (($C' ($C' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) (($B (($C' ($C' ($C' $C))) (($B ($B ($B (($S' $S') (_83 0))))) (($B (($C' ($C' $C)) (($B ($B (($S' $S') (_83 1)))) (($B (($C' $C) (($B (($C' $S') (_83 2))) ($C _95)))) ($C _95))))) ($C _95))))) ($C _95)))) ($T $K))) ($T $A)))) (($C _93) 4)))) (($A :96 (_102 _71)) (($A :97 ((_117 (_74 _96)) _94)) (($A :98 (($C ((($C' $B) (($P _109) ((($C' ($C' $O)) $P) $K))) ((($S' ($C' ($C' ($C' $B)))) (($B ($B ($B ($B _99)))) ((($S' ($C' ($C' $B))) (($B ($B ($B _99))) ((($S' ($C' $B)) (($B ($B _99)) ((($C' $B) (($B _115) ($T 0))) _98))) ((($C' $B) (($B _115) ($T 1))) _98)))) ((($C' $B) (($B _115) ($T 2))) _98)))) ((($C' $B) (($B _115) ($T 3))) _98)))) (($B $T) (($B ($B $P)) (($C' _76) (_78 4)))))) (($A :99 (($S $S) (($B $BK) (($B $BK) ((($S' $S) $T) (($B $BK) (($B $BK) (($C ((($S' $C') $S) (($B ($B ($B ($S $B)))) (($B ($B ($B ($B ($B $BK))))) (($B (($S' ($C' $B)) (($B $B') $B'))) (($B ($B ($B ($B ($B ($S $B)))))) (($B ($B ($B ($B ($B ($B ($B $BK))))))) ((($C' $B) ($B' ($B' (($B ($C' ($C' ($C' $C)))) (($B (($C' $B) ($B' (($B $C) _85)))) (($B (($C' $B) _110)) _99)))))) (($B (($C' $B) _110)) ($C _99)))))))))) (((_735 "lib/Data/IntMap.hs") 3) 8))))))))) (($A :100 ((_69 (_115 _181)) _98)) (($A :101 ((($C' $C) ((($C' $C) ($C _95)) (_3 "Data.IntMap.!"))) $I)) (($A :102 (($B (($C' $B) $T)) (($B ($B $Y)) ((($C' ($C' ($
\ No newline at end of file
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -435,9 +435,7 @@
showLit l =
case l of
LInt i -> showInt i
- LDouble d -> case D.showDouble d of
- '-':xs -> '-':'f':xs
- xs -> 'f':xs
+ LDouble d -> '%' : D.showDouble d
LChar c -> showChar c
LStr s -> showString s
LPrim s -> '$' : s
--- a/src/runtime/eval.c
+++ b/src/runtime/eval.c
@@ -171,6 +171,7 @@
enum node_tag tag;
union {value_t value;
+ double doublevalue;
FILE *file;
const char *string;
struct {@@ -188,9 +189,9 @@
#define GETVALUE(p) (p)->u.value
// to squeeze a double into value_t we must exactly copy and read the bits
// this is a stm, and not an exp
-#define GETDOUBLEVALUE(p,d) do { memcpy(&d, &((p)->u.value), 8); } while(0)+#define GETDOUBLEVALUE(p) (p)->u.doublevalue
#define SETVALUE(p,v) (p)->u.value = v
-#define SETDOUBLEVALUE(p,v) do { memcpy(&((p)->u.value), &v, 8); } while(0)+#define SETDOUBLEVALUE(p,v) (p)->u.doublevalue = v
#define FUN(p) (p)->u.s.fun
#define ARG(p) (p)->u.s.arg
#define NEXT(p) FUN(p)
@@ -211,6 +212,7 @@
union {struct node *uuarg;
value_t uuvalue;
+ double uudoublevalue;
FILE *uufile;
const char *uustring;
} uarg;
@@ -221,9 +223,9 @@
#define GETTAG(p) ((p)->ufun.uutag & 1 ? (int)((p)->ufun.uutag >> 1) : T_AP)
#define SETTAG(p,t) do { if (t != T_AP) (p)->ufun.uutag = ((t) << 1) + 1; } while(0)#define GETVALUE(p) (p)->uarg.uuvalue
-#define GETDOUBLEVALUE(p, d) do { memcpy(&d, &((p)->uarg.uuvalue), 8); } while(0)+#define GETDOUBLEVALUE(p) (p)->uarg.uudoublevalue
#define SETVALUE(p,v) (p)->uarg.uuvalue = v
-#define SETDOUBLEVALUE(p,v) do { memcpy(&((p)->uarg.uuvalue), &v, 8); } while(0)+#define SETDOUBLEVALUE(p,v) (p)->uarg.uudoublevalue = v
#define FUN(p) (p)->ufun.uufun
#define ARG(p) (p)->uarg.uuarg
#define STR(p) (p)->uarg.uustring
@@ -784,34 +786,21 @@
double
parse_double(BFILE *f)
{- // apparently longest float, when rendered, takes up 24 characters
+ // apparently longest float, when rendered, takes up 24 characters. We add one more for a potential
+ // minus sign, and another one for the final null terminator.
// https://stackoverflow.com/questions/1701055/what-is-the-maximum-length-in-chars-needed-to-represent-any-double-value
// I expect Lennart will hate this...
- char floatstr[24];
+ char floatstr[26];
int i = 0;
for(;;) {int c = getb(f);
- if (c < '0' || c > '9') {+ if ((c != '-' && c != '.') && (c < '0' || c > '9')) {ungetb(c, f);
break;
}
floatstr[i++] = c;
}
- int c = getb(f);
- if(c != '.') {- ERR("can not parse double");- }
- floatstr[i++] = '.';
- for(;;) {- int c = getb(f);
- if(c < '0' || c > '9') {- ungetb(c, f);
- break;
- }
- floatstr[i++] = c;
- }
-
floatstr[i++] = '\0';
double d = strtod(floatstr, NULL);
return d;
@@ -884,20 +873,13 @@
neg = -1;
if ('0' <= c && c <= '9') {goto number;
- } else if (c == 'f') {- goto flabel; // this stuff is cursed, I am not as much of a hacker as Lennart
} else { ERR("got -");}
- case 'f':
- neg = 1;
- flabel:
- c = getb(f);
- if('0' <= c && c <= '9') {- goto floatingnumber;
- } else {- ERR("got f");- }
+ case '%':
+ d = parse_double(f);
+ r = mkDouble(d);
+ return r;
case '0':case '1':case '2':case '3':case '4':case '5':case '6':case '7':case '8':case '9':
/* integer [0-9]+*/
neg = 1;
@@ -906,11 +888,6 @@
i = neg * parse_int(f);
r = mkInt(i);
return r;
- floatingnumber:
- ungetb(c, f);
- d = neg * parse_double(f);
- r = mkDouble(d);
- return r;
case '$':
/* A primitive, keep getting char's until end */
for (int j = 0;;) {@@ -1161,11 +1138,7 @@
fputc(')', f);break;
case T_INT: fprintf(f, "%"PRIvalue, GETVALUE(n)); break;
- case T_DOUBLE:
- double d;
- GETDOUBLEVALUE(n, d);
- fprintf(f, "%f", d);
- break;
+ case T_DOUBLE: fprintf(f, "%f", GETDOUBLEVALUE(n)); break;
case T_STR:
{const char *p = STR(n);
@@ -1373,18 +1346,6 @@
return n;
}
-static inline NODEPTR
-evald(NODEPTR n)
-{- PUSH(n);
- eval(n);
- n = TOP(0);
- POP(1);
- while (GETTAG(n) == T_IND)
- n = INDIR(n);
- return n;
-}
-
/* Follow indirections */
static inline NODEPTR
indir(NODEPTR n)
@@ -1412,7 +1373,7 @@
static inline double
evaldouble(NODEPTR n)
{- n = evald(n);
+ n = evali(n);
#if SANITY
if (GETTAG(n) != T_DOUBLE) {fprintf(stderr, "bad tag %d\n", GETTAG(n));
@@ -1419,9 +1380,7 @@
ERR("evaldouble");}
#endif
- double d;
- GETDOUBLEVALUE(n, d);
- return d;
+ return GETDOUBLEVALUE(n);
}
/* Evaluate to a T_HDL */
@@ -1694,14 +1653,11 @@
// turn it into a string
char str[25];
- memset(str, '\0', 25);
- snprintf(str, 25, "%f", xd);
+ int idx = snprintf(str, 25, "%f", xd);
/* C will render floats with potentially many training zeros, shave the
off by moving the NULL terminator */
- int idx = 24;
- while(str[idx] == '\0') idx--;
- for(int i = idx; i >= 0; i--) {+ for(int i = idx - 1; i >= 0; i--) { if(str[i] == '.') { str[i+2] = '\0'; // number is x.0, create {x, '.', '0', '\0'}break;
--
⑨