open Flx_ast
open Flx_print
open Flx_exceptions
open List
open Flx_typing
open Flx_set
open Flx_maps
open Flx_literal
let truth sr r =
let r = if r then 1 else 0 in
`EXPR_typed_case (sr,r,flx_bool)
)
let mkstring sr x = `EXPR_literal (sr, {felix_type="string"; internal_value=x;
c_value=Flx_string.c_quote_of_string x})
let const_fold' e sr name arg =
)
let mkstring x = mkstring sr x in
match name, arg with
)
)
| "neg", `EXPR_literal (_,{felix_type="int"; internal_value=x})
-> mkint (minus x)
)
| "pos", `EXPR_literal (_,{felix_type="int"; internal_value=x})
-> mkint x
)
| "abs", `EXPR_literal (_,{felix_type="int"; internal_value=x})
-> mkint (abs x)
)
| "+", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
-> mkint (add x y)
)
| "-", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
mkint (sub x y)
)
| "*", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
mkint (mult x y)
)
| "/", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
let r =
try div x y
with Division_by_zero ->
clierrx "[flx_desugar/flx_constfld.ml:87: E315] " sr "[constfld] Division by zero"
in
mkint r
)
| "mod", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
let r =
try modu x y
with Division_by_zero ->
clierrx "[flx_desugar/flx_constfld.ml:101: E316] " sr "[constfld] Division by zero"
in
mkint r
)
| "pow", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
mkint (pow x y)
)
| "<", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
truth sr (lt x y)
)
| ">", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
truth sr (gt x y)
)
| "<=", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
truth sr (le x y)
)
| ">=", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
truth sr (ge x y)
)
| "==", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
truth sr (eq x y)
)
| "!=", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="int"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
truth sr (not (eq x y))
*)
)
)
| "+", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="string"; internal_value=x});
`EXPR_literal (_,{felix_type="string"; internal_value=y})
])
->
let r = String.concat "" [x; y] in mkstring r
)
| "*", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="string"; internal_value=x});
`EXPR_literal (_,{felix_type="int"; internal_value=y})
])
->
let y =
try
int_of_string y
with _ -> clierrx "[flx_desugar/flx_constfld.ml:179: E317] " sr "String repeat count too large"
in
if String.length x = 1 then
let r = String.make y x.[0] in
mkstring r
else
let s = Buffer.create (String.length x * y) in
for i = 1 to y do
Buffer.add_string s x
done;
let r = Buffer.contents s in
mkstring r
)
| "==", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="string"; internal_value=x});
`EXPR_literal (_,{felix_type="string"; internal_value=y})
])
->
truth sr (x = y)
)
| "!=", `EXPR_tuple ( _, [
`EXPR_literal (_,{felix_type="string"; internal_value=x});
`EXPR_literal (_,{felix_type="string"; internal_value=y})
])
->
truth sr (x <> y)
)
)
| "lnot", `EXPR_typed_case (_,x,`TYP_unitsum 2)
->
truth sr (x=0)
)
| "lor", `EXPR_tuple ( _, [
`EXPR_typed_case (_,x,`TYP_unitsum 2);
`EXPR_typed_case (_,y,`TYP_unitsum 2)
])
-> truth sr (x=1 || y=1)
)
| "land", `EXPR_tuple ( _, [
`EXPR_typed_case (_,x,`TYP_unitsum 2);
`EXPR_typed_case (_,y,`TYP_unitsum 2)
])
-> truth sr (x=1 && y=1)
)
| "==", `EXPR_tuple ( _, [
`EXPR_typed_case (_,x,`TYP_unitsum 2);
`EXPR_typed_case (_,y,`TYP_unitsum 2)
])
-> truth sr (x=y)
)
| "!=", `EXPR_tuple ( _, [
`EXPR_typed_case (_,x,`TYP_unitsum 2);
`EXPR_typed_case (_,y,`TYP_unitsum 2)
])
-> truth sr (x<>y)
| _ -> e
let rec const_fold e =
let e' = map_expr const_fold e in
match e' with
| `EXPR_not (sr, `EXPR_not (sr2, e)) -> e )
| `EXPR_apply (sr, (`EXPR_name (_,name,[]),arg)) ->
const_fold' e sr name arg
| `EXPR_apply ( sr, ((`EXPR_literal (_,{felix_type="string"; internal_value=_}) as x), y)) ->
const_fold' e sr "add" (`EXPR_tuple (sr,[x;y]))
| _ -> e'