5.28. Constant folding

These routines provide constant folding. Felix recognizes plain integers, strings, and boolean values as constants, and folds expressions involving all the basic operations on them as follows:
  // 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 987
have 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.

Start ocaml section to src/flx_constfld.mli[1 /1 ]
     1: # 70 "./lpsrc/flx_constfld.ipk"
     2: open Flx_ast
     3: val const_fold:
     4:   expr_t -> expr_t
     5: 
End ocaml section to src/flx_constfld.mli[1]
Start ocaml section to src/flx_constfld.ml[1 /1 ]
     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: 
End ocaml section to src/flx_constfld.ml[1]