// integers -x, neg x +x, pos x abs x x+y, add (x,y) x-y, sub(x,y) x*y, mul(x,y) x/y, div(x,y) x % y, mod(x,y) x ** y, pow(x,y) x<y, lt(x,y) x>y, gt(x,y) x<=y, le(x,y) x>=y, ge(x,y) x=y, eq(x,y) x!=y, x<>y,ne(x,y) // strings x+y, add x*n, mul(x,n) // concatenate n copies of x x=y, eq(x,y) x!=y, x<>y,ne(x,y) x n // append the utf8 encoding of n to x x y // same as x + y // ustrings x+y, add x*n, mul(x,n) // concatenate n copies of x x=y, eq(x,y) x!=y, x<>y,ne(x,y) x n // append the char of code value n to x // bool not x, lnot(x,y) x or y, lor(x,y) x and y, land(x,y) x=y, eq(x,y) x!=y, x<>y,ne(x,y) // conditional if c then e1 else e2 endif // compile time shortcut
Note the conditional fold, which replaces the conditional with either e1 or e2 if c is a boolean constant expression.
Note the string formation forms:
"" 27 987 u"" 27 987have the same ISO-10646 interpretation, however the first string is 8 bit, and the 987 is replaced by its UTF-8 encoding, whilst the second string is 32 bit, and the integral value is represented directly.
Implementation note: both string types are represented internally by 8 bit UTF-8 encoded strings.
1: # 70 "./lpsrc/flx_constfld.ipk" 2: open Flx_ast 3: val const_fold: 4: expr_t -> expr_t 5:
1: # 76 "./lpsrc/flx_constfld.ipk" 2: open Flx_ast 3: open Flx_print 4: open Flx_exceptions 5: open List 6: open Flx_typing 7: open Big_int 8: open Flx_mtypes1 9: open Flx_maps 10: 11: let truth sr r = 12: let r = if r then 1 else 0 in 13: `AST_typed_case (sr,r,flx_bool) 14: 15: let const_fold' e sr name arg = 16: match name, arg with 17: (* integers *) 18: (* -x *) 19: | "neg", `AST_literal (_,`AST_int ("int",x)) 20: -> 21: `AST_literal (sr,`AST_int ("int", (minus_big_int x))) 22: 23: (* +x *) 24: | "pos", `AST_literal (_,`AST_int ("int",x)) 25: -> 26: `AST_literal (sr,`AST_int ("int", x)) 27: 28: (* abs x *) 29: | "abs", `AST_literal (_,`AST_int ("int",x)) 30: -> 31: `AST_literal (sr,`AST_int ("int", (abs_big_int x))) 32: 33: (* x+y *) 34: | "add", `AST_tuple ( _, [ 35: `AST_literal (_,`AST_int ("int",x)); 36: `AST_literal (_,`AST_int ("int",y)) 37: ]) 38: -> 39: `AST_literal (sr,`AST_int ("int",(add_big_int x y))) 40: 41: (* x-y *) 42: | "sub", `AST_tuple ( _, [ 43: `AST_literal (_,`AST_int ("int",x)); 44: `AST_literal (_,`AST_int ("int",y)) 45: ]) 46: -> 47: `AST_literal (sr,`AST_int ("int",(sub_big_int x y))) 48: 49: (* x*y *) 50: | "mul", `AST_tuple ( _, [ 51: `AST_literal (_,`AST_int ("int",x)); 52: `AST_literal (_,`AST_int ("int",y)) 53: ]) 54: -> 55: `AST_literal (sr,`AST_int ("int",(mult_big_int x y))) 56: 57: (* x/y *) 58: | "div", `AST_tuple ( _, [ 59: `AST_literal (_,`AST_int ("int",x)); 60: `AST_literal (_,`AST_int ("int",y)) 61: ]) 62: -> 63: let r = 64: try div_big_int x y 65: with Division_by_zero -> 66: clierr sr "[constfld] Division by zero" 67: in 68: `AST_literal (sr,`AST_int ("int",r)) 69: 70: 71: (* x mod y *) 72: | "mod", `AST_tuple ( _, [ 73: `AST_literal (_,`AST_int ("int",x)); 74: `AST_literal (_,`AST_int ("int",y)) 75: ]) 76: -> 77: let r = 78: try mod_big_int x y 79: with Division_by_zero -> 80: clierr sr "[constfld] Division by zero" 81: in 82: `AST_literal (sr,`AST_int ("int",r)) 83: 84: (* x ** y *) 85: | "pow", `AST_tuple ( _, [ 86: `AST_literal (_,`AST_int ("int",x)); 87: `AST_literal (_,`AST_int ("int",y)) 88: ]) 89: -> 90: `AST_literal (sr,`AST_int ("int",(power_big_int_positive_big_int x y))) 91: 92: (* x < y *) 93: | "lt", `AST_tuple ( _, [ 94: `AST_literal (_,`AST_int ("int",x)); 95: `AST_literal (_,`AST_int ("int",y)) 96: ]) 97: -> 98: truth sr (lt_big_int x y) 99: 100: (* x > y *) 101: | "gt", `AST_tuple ( _, [ 102: `AST_literal (_,`AST_int ("int",x)); 103: `AST_literal (_,`AST_int ("int",y)) 104: ]) 105: -> 106: truth sr (gt_big_int x y) 107: 108: (* x <= y *) 109: | "le", `AST_tuple ( _, [ 110: `AST_literal (_,`AST_int ("int",x)); 111: `AST_literal (_,`AST_int ("int",y)) 112: ]) 113: -> 114: truth sr (le_big_int x y) 115: 116: (* x >= y *) 117: | "ge", `AST_tuple ( _, [ 118: `AST_literal (_,`AST_int ("int",x)); 119: `AST_literal (_,`AST_int ("int",y)) 120: ]) 121: -> 122: truth sr (ge_big_int x y) 123: 124: (* x == y *) 125: | "eq", `AST_tuple ( _, [ 126: `AST_literal (_,`AST_int ("int",x)); 127: `AST_literal (_,`AST_int ("int",y)) 128: ]) 129: -> 130: truth sr (eq_big_int x y) 131: 132: (* x != y *) 133: | "ne", `AST_tuple ( _, [ 134: `AST_literal (_,`AST_int ("int",x)); 135: `AST_literal (_,`AST_int ("int",y)) 136: ]) 137: -> 138: truth sr (not (eq_big_int x y)) 139: 140: (* strings *) 141: (* x+y *) 142: | "add", `AST_tuple ( _, [ 143: `AST_literal (_,`AST_string x); 144: `AST_literal (_,`AST_string y) 145: ]) 146: -> 147: `AST_literal (sr,`AST_string (String.concat "" [x; y])) 148: 149: (* x*y *) 150: | "mul", `AST_tuple ( _, [ 151: `AST_literal (_,`AST_string x); 152: `AST_literal (_,`AST_int ("int",y)) 153: ]) 154: -> 155: let y = 156: try 157: int_of_big_int y 158: with _ -> clierr sr "String repeat count too large" 159: in 160: if String.length x = 1 then 161: `AST_literal (sr,`AST_string (String.make y x.[0])) 162: else 163: let s = Buffer.create (String.length x * y) in 164: for i = 1 to y do 165: Buffer.add_string s x 166: done; 167: `AST_literal (sr,`AST_string (Buffer.contents s)) 168: 169: (* x == y *) 170: | "eq", `AST_tuple ( _, [ 171: `AST_literal (_,`AST_string x); 172: `AST_literal (_,`AST_string y) 173: ]) 174: -> 175: truth sr (x = y) 176: 177: (* x != y *) 178: | "ne", `AST_tuple ( _, [ 179: `AST_literal (_,`AST_string x); 180: `AST_literal (_,`AST_string y) 181: ]) 182: -> 183: truth sr (x <> y) 184: 185: 186: (* bool *) 187: (* not x *) 188: | "lnot", `AST_typed_case (_,x,`TYP_unitsum 2) 189: -> 190: truth sr (x=0) 191: 192: (* x or y *) 193: | "lor", `AST_tuple ( _, [ 194: `AST_typed_case (_,x,`TYP_unitsum 2); 195: `AST_typed_case (_,y,`TYP_unitsum 2) 196: ]) 197: -> truth sr (x=1 or y=1) 198: 199: (* x and y *) 200: | "land", `AST_tuple ( _, [ 201: `AST_typed_case (_,x,`TYP_unitsum 2); 202: `AST_typed_case (_,y,`TYP_unitsum 2) 203: ]) 204: -> truth sr (x=1 && y=1) 205: 206: (* x eq y *) 207: | "eq", `AST_tuple ( _, [ 208: `AST_typed_case (_,x,`TYP_unitsum 2); 209: `AST_typed_case (_,y,`TYP_unitsum 2) 210: ]) 211: -> truth sr (x=y) 212: 213: (* x ne y *) 214: | "ne", `AST_tuple ( _, [ 215: `AST_typed_case (_,x,`TYP_unitsum 2); 216: `AST_typed_case (_,y,`TYP_unitsum 2) 217: ]) 218: -> truth sr (x<>y) 219: 220: | _ -> e 221: 222: let rec const_fold e = 223: let e' = map_expr const_fold e in 224: match e' with 225: | `AST_apply (sr, (`AST_name (_,name,[]),arg)) -> 226: const_fold' e sr name arg 227: 228: | `AST_apply ( sr, (( `AST_literal (_,`AST_string _) as x), y)) -> 229: const_fold' e sr "add" (`AST_tuple (sr,[x;y])) 230: 231: | _ -> e' 232: 233: