Commit fb68f9e7 authored by Camil Staps's avatar Camil Staps 🍃

Interpreter generator: specify types to resolve overloading

parent 2bbc3e69
Pipeline #24730 failed with stages
in 1 minute and 8 seconds
......@@ -307,16 +307,13 @@ instr_RtoAC :: !Target -> Target
instr_RtoAC t = (
new_local TReal (to_real (B @ 0)) \r ->
new_local TPtrOffset (Ecall "clean_RtoAC_words_needed" [r]) \lw ->
//ensure_hp (lw ::: TPtrOffset) :. // TODO
ensure_hp lw :.
A @ 1 .= to_word Hp :.
Hp .= (Ecall "clean_RtoAC" [Hp,r] ::: TPtr TWord) :.
advance_ptr Pc 1 :.
advance_ptr A 1 :.
advance_ptr B 1
) t
where
(:::) :: !(Expr t) t -> Expr t
(:::) e _ = e
lit_word :: !Int -> Expr TWord
lit_word w = Econst I64 w
......@@ -657,24 +654,18 @@ if_break_else c else t = else (append (Ebr_if 0 c) t)
instance ensure_hp (Expr t) | to_ptr_offset t
where
ensure_hp i t = if_then_else
(Elt I32 Signed Hp_free (Econst I32 0))
(Hp_free += to_ptr_offset i :. append (Ebr "abc-gc"))
[]
Nothing
((Hp_free .= Hp_free - to_ptr_offset i) t)
instance ensure_hp Int
where
ensure_hp i t = if_then_else
(Elt I32 Signed Hp_free (Econst I32 0))
(Hp_free += ie :. append (Ebr "abc-gc"))
[]
Nothing
((Hp_free .= Hp_free - ie) t)
where
ie :: Expr TPtrOffset
ie = Econst I32 i
ensure_hp i t = real_ensure_hp (to_ptr_offset i) t
instance ensure_hp Ex where ensure_hp i t = real_ensure_hp i t
instance ensure_hp Int where ensure_hp i t = real_ensure_hp (Econst I32 i) t
real_ensure_hp :: !(Expr TPtrOffset) !Target -> Target
real_ensure_hp e t = if_then_else
(Elt I32 Signed Hp_free (Econst I32 0))
(Hp_free += e :. append (Ebr "abc-gc"))
[]
Nothing
((Hp_free .= Hp_free - e) t)
A :: Expr (TPtr TWord)
A = Ivar (rt_var "asp")
......
......@@ -18,6 +18,10 @@ from target import :: Expr
:: TPtr t = TPtr !t
:: TPtrOffset = TPtrOffset
/* Used to specify types for expressions. See this issue for discussion:
* https://gitlab.science.ru.nl/clean-compiler-and-rts/compiler/issues/15 */
(:::) :: !(Expr t) t -> Expr t
class to_word t :: !(Expr t) -> Expr TWord
class to_bool t :: !(Expr t) -> Expr TBool
class to_char t :: !(Expr t) -> Expr TChar
......
......@@ -51,6 +51,9 @@ where
($) infixr 0
($) f :== f
(:::) :: !(Expr t) t -> Expr t // used to specify types
(:::) e _ = e
all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t) $
[ instr "absR" (Just 0) $
new_local TReal (absR (to_real (B @ 0))) \r ->
......@@ -2171,7 +2174,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
A @ (n_a - i) .= n @ 0 :.
i += lit_hword 1
) :.
grow_a (to_ptr_offset n_a) :. // NB: compiler cannot resolve overloading without to_ptr_offset
grow_a (n_a ::: TPtrOffset) :.
while_do (i <. n_total) (
B @ (n_a - n_total + i) .= n @ 0 :.
advance_ptr n 1 :.
......@@ -2837,7 +2840,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
if_then (end_i >. to_int l) (end_i .= to_int l) :.
l .= to_word (end_i - first_i) :.
new_local TWord (if_i64_or_i32_expr ((l + lit_word 7) >>. lit_word 3) ((l + lit_word 3) >>. lit_word 2) + lit_word 2) \lw ->
ensure_hp (to_ptr_offset lw) :. // NB: compiler cannot resolve overloading without to_ptr_offset
ensure_hp (to_ptr_offset lw) :.
shrink_b 2 :.
Hp @ 0 .= STRING__ptr + lit_word 2 :.
Hp @ 1 .= l :.
......@@ -3029,7 +3032,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
Hp @ 1 .= l :.
new_local (TPtr TChar) (to_char_ptr (Hp @? 2)) \p ->
p @ 0 .= lit_char '-' :.
advance_ptr p (to_ptr_offset l) :. // NB: compiler cannot resolve overloading without to_ptr_offset
advance_ptr p (l ::: TPtrOffset) :.
advance_ptr Hp lw :.
advance_ptr Pc 1 :.
while_do (ui >=. lit_word 10) (
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment