Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove packing for bools. #5449

Merged
merged 7 commits into from
Dec 3, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Remove boolift/notlift
  • Loading branch information
ChrisPenner committed Dec 2, 2024
commit 2424312be2fe20a3ef99c29895cdfc8978b281d8
6 changes: 6 additions & 0 deletions unison-runtime/src/Unison/Runtime/ANF.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1404,6 +1404,8 @@ data POp
| -- Universal operations
EQLU -- ==
| CMPU -- compare
| LEQU -- <=
| LESU -- <
| EROR -- error
| -- Code
MISS -- isMissing
Expand Down Expand Up @@ -1431,6 +1433,10 @@ data POp
| RCAS -- Ref.cas
| RRFC -- Ref.readForCas
| TIKR -- Ref.Ticket.read
-- Bools
| NOTB -- not
| ANDB -- and
| IORB -- or
deriving (Show, Eq, Ord, Enum, Bounded)

type ANormal = ABTN.Term ANormalF
Expand Down
11 changes: 11 additions & 0 deletions unison-runtime/src/Unison/Runtime/ANF/Serialize.hs
Original file line number Diff line number Diff line change
Expand Up @@ -662,6 +662,17 @@ pOpCode op = case op of
RCAS -> 134
RRFC -> 135
TIKR -> 136
LESI -> 137
NEQI -> 138
LESN -> 139
NEQN -> 140
LESF -> 141
NEQF -> 142
LEQU -> 143
LESU -> 144
NOTB -> 145
ANDB -> 146
IORB -> 147

pOpAssoc :: [(POp, Word16)]
pOpAssoc = map (\op -> (op, pOpCode op)) [minBound .. maxBound]
Expand Down
121 changes: 26 additions & 95 deletions unison-runtime/src/Unison/Runtime/Builtin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -282,14 +282,6 @@ seqViewEmpty = TCon Ty.seqViewRef (fromIntegral Ty.seqViewEmpty) []
seqViewElem :: (Var v) => v -> v -> ANormal v
seqViewElem l r = TCon Ty.seqViewRef (fromIntegral Ty.seqViewElem) [l, r]

boolift :: (Var v) => v -> ANormal v
boolift v =
TMatch v $ MatchIntegral (mapFromList [(0, fls), (1, tru)]) Nothing

notlift :: (Var v) => v -> ANormal v
notlift v =
TMatch v $ MatchIntegral (mapFromList [(1, fls), (0, tru)]) Nothing

unenum :: (Var v) => Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum n v0 r v nx =
TMatch v0 $ MatchData r cases Nothing
Expand Down Expand Up @@ -330,20 +322,6 @@ binopSwap :: (Var v) => POp -> SuperNormal v
binopSwap pop =
binop0 0 $ \[x, y] -> TPrm pop [y, x]

-- | Like `binop`, but swaps the arguments.
cmpopb :: (Var v) => POp -> SuperNormal v
cmpopb pop =
binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm pop [y, x]) $
boolift b

-- | Like `binop`, but swaps arguments then negates the result.
cmpopbn :: (Var v) => POp -> SuperNormal v
cmpopbn pop =
binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm pop [y, x]) $
notlift b

addi, subi, muli, divi, modi, shli, shri, powi :: (Var v) => SuperNormal v
addi = binop ADDI
subi = binop SUBI
Expand Down Expand Up @@ -375,9 +353,9 @@ len = binop LEQN

gti, gtn, gei, gen :: (Var v) => SuperNormal v
gti = binopSwap LESI
gei = cmpopb LEQI
gei = binopSwap LEQI
gtn = binopSwap LESN
gen = cmpopb LEQN
gen = binopSwap LEQN

inci, incn :: (Var v) => SuperNormal v
inci = unop INCI
Expand Down Expand Up @@ -452,10 +430,10 @@ atanhf = unop ATNH
atan2f = binop ATN2

ltf, gtf, lef, gef, eqf, neqf :: (Var v) => SuperNormal v
ltf = cmpopbn LEQF
ltf = binop LESF
gtf = binopSwap LESF
lef = binop LEQF
gef = cmpopb LEQF
gef = binopSwap LEQF
eqf = binop EQLF
neqf = binop NEQF

Expand Down Expand Up @@ -628,24 +606,18 @@ splitrs = binop0 3 $ \[n, s, t, l, r] ->
]

eqt, neqt, leqt, geqt, lesst, great :: SuperNormal Symbol
eqt = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm EQLT [x, y]) $
boolift b
eqt = binop EQLT
neqt = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm EQLT [x, y]) $
notlift b
leqt = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm LEQT [x, y]) $
boolift b
geqt = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm LEQT [y, x]) $
boolift b
TPrm NOTB [b]
leqt = binop LEQT
geqt = binopSwap LEQT
lesst = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm LEQT [y, x]) $
notlift b
TPrm NOTB [b]
great = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm LEQT [x, y]) $
notlift b
TPrm NOTB [b]

packt, unpackt :: SuperNormal Symbol
packt = unop0 0 $ \[s] -> TPrm PAKT [s]
Expand Down Expand Up @@ -712,61 +684,31 @@ t2f = unop0 2 $ \[x, t, f] ->
]

equ :: SuperNormal Symbol
equ = binop0 1 $ \[x, y, b] ->
TLetD b UN (TPrm EQLU [x, y]) $
boolift b
equ = binop EQLU

cmpu :: SuperNormal Symbol
cmpu = binop0 1 $ \[x, y, c] ->
TLetD c UN (TPrm CMPU [x, y]) $
(TPrm DECI [c])
cmpu = binop CMPU

ltu :: SuperNormal Symbol
ltu = binop0 1 $ \[x, y, c] ->
TLetD c UN (TPrm CMPU [x, y])
. TMatch c
$ MatchIntegral
(mapFromList [(0, TCon Ty.booleanRef 1 [])])
(Just $ TCon Ty.booleanRef 0 [])
ltu = binop LESU

gtu :: SuperNormal Symbol
gtu = binop0 1 $ \[x, y, c] ->
TLetD c UN (TPrm CMPU [x, y])
. TMatch c
$ MatchIntegral
(mapFromList [(2, TCon Ty.booleanRef 1 [])])
(Just $ TCon Ty.booleanRef 0 [])
gtu = binopSwap LESU

geu :: SuperNormal Symbol
geu = binop0 1 $ \[x, y, c] ->
TLetD c UN (TPrm CMPU [x, y])
. TMatch c
$ MatchIntegral
(mapFromList [(0, TCon Ty.booleanRef 0 [])])
(Just $ TCon Ty.booleanRef 1 [])
geu = binopSwap LEQU

leu :: SuperNormal Symbol
leu = binop0 1 $ \[x, y, c] ->
TLetD c UN (TPrm CMPU [x, y])
. TMatch c
$ MatchIntegral
(mapFromList [(2, TCon Ty.booleanRef 0 [])])
(Just $ TCon Ty.booleanRef 1 [])
leu = binop LEQU

notb :: SuperNormal Symbol
notb = unop0 0 $ \[b] ->
TMatch b . flip (MatchData Ty.booleanRef) Nothing $
mapFromList [(0, ([], tru)), (1, ([], fls))]
notb = unop NOTB

orb :: SuperNormal Symbol
orb = binop0 0 $ \[p, q] ->
TMatch p . flip (MatchData Ty.booleanRef) Nothing $
mapFromList [(1, ([], tru)), (0, ([], TVar q))]
orb = binop IORB

andb :: SuperNormal Symbol
andb = binop0 0 $ \[p, q] ->
TMatch p . flip (MatchData Ty.booleanRef) Nothing $
mapFromList [(0, ([], fls)), (1, ([], TVar q))]
andb = binop ANDB

-- A runtime type-cast. Used to unsafely coerce between unboxed
-- types at runtime without changing their representation.
Expand Down Expand Up @@ -865,10 +807,7 @@ debug'text =
]

code'missing :: SuperNormal Symbol
code'missing =
unop0 1 $ \[link, b] ->
TLetD b UN (TPrm MISS [link]) $
boolift b
code'missing = unop MISS

code'cache :: SuperNormal Symbol
code'cache = unop0 0 $ \[new] -> TPrm CACH [new]
Expand Down Expand Up @@ -923,13 +862,7 @@ value'create :: SuperNormal Symbol
value'create = unop0 0 $ \[x] -> TPrm VALU [x]

check'sandbox :: SuperNormal Symbol
check'sandbox =
Lambda [BX, BX]
. TAbss [refs, val]
. TLetD b UN (TPrm SDBX [refs, val])
$ boolift b
where
(refs, val, b) = fresh
check'sandbox = binop SDBX

sandbox'links :: SuperNormal Symbol
sandbox'links = Lambda [BX] . TAbs ln $ TPrm SDBL [ln]
Expand Down Expand Up @@ -1011,10 +944,9 @@ ref'cas :: SuperNormal Symbol
ref'cas =
Lambda [BX, BX, BX]
. TAbss [x, y, z]
. TLetD b UN (TPrm RCAS [x, y, z])
$ boolift b
$ TPrm RCAS [x, y, z]
where
(x, y, z, b) = fresh
(x, y, z) = fresh

ref'ticket'read :: SuperNormal Symbol
ref'ticket'read = unop0 0 $ TPrm TIKR
Expand Down Expand Up @@ -1391,8 +1323,7 @@ outIoFailBool stack1 stack2 stack3 extra fail result =
( 1,
([UN],)
. TAbs stack3
. TLet (Indirect 1) extra BX (boolift stack3)
$ right extra
$ right stack3
)
]

Expand Down Expand Up @@ -1488,9 +1419,9 @@ argNToBool :: Int -> ForeignOp
argNToBool n instr =
(replicate n BX,)
. TAbss args
$ TLetD result UN (TFOp instr args) (boolift result)
$ TFOp instr args
where
(result : args) = freshes (n + 1)
args = freshes n

argNDirect :: Int -> ForeignOp
argNDirect n instr =
Expand Down
10 changes: 8 additions & 2 deletions unison-runtime/src/Unison/Runtime/Foreign/Function.hs
Original file line number Diff line number Diff line change
Expand Up @@ -295,8 +295,14 @@ instance ForeignConvention Double where
pure stk

instance ForeignConvention Bool where
readForeign = readForeignEnum
writeForeign = writeForeignEnum
readForeign (i : args) stk = do
b <- peekOffBool stk i
pure (args, b)
readForeign _ _ = foreignCCError "Bool"
writeForeign stk b = do
stk <- bump stk
pokeBool stk b
pure stk

instance ForeignConvention String where
readForeign = readForeignAs unpack
Expand Down
13 changes: 13 additions & 0 deletions unison-runtime/src/Unison/Runtime/MCode.hs
Original file line number Diff line number Diff line change
Expand Up @@ -324,6 +324,8 @@ data UPrim1
| TRNF -- truncate
| RNDF -- round
| TRNC -- truncate
-- Bools
| NOTB -- not
deriving (Show, Eq, Ord, Enum, Bounded)

data UPrim2
Expand Down Expand Up @@ -374,6 +376,9 @@ data UPrim2
| MINF -- min
| CAST -- unboxed runtime type cast (int to nat, etc.)
| DRPN -- dropn
-- Bools
| ANDB -- and
| IORB -- or
deriving (Show, Eq, Ord, Enum, Bounded)

data BPrim1
Expand Down Expand Up @@ -419,6 +424,8 @@ data BPrim2
= -- universal
EQLU -- ==
| CMPU -- compare
| LEQU -- <=
| LESU -- <
-- text
| DRPT -- drop
| CATT -- append
Expand Down Expand Up @@ -1333,6 +1340,8 @@ emitPOp ANF.FLTB = emitBP1 FLTB
emitPOp ANF.CATB = emitBP2 CATB
-- universal comparison
emitPOp ANF.EQLU = emitBP2 EQLU
emitPOp ANF.LEQU = emitBP2 LEQU
emitPOp ANF.LESU = emitBP2 LESU
emitPOp ANF.CMPU = emitBP2 CMPU
-- code operations
emitPOp ANF.MISS = emitBP1 MISS
Expand All @@ -1358,6 +1367,10 @@ emitPOp ANF.RRFC = emitBP1 RRFC
emitPOp ANF.TIKR = emitBP1 TIKR
-- non-prim translations
emitPOp ANF.BLDS = Seq
-- Bools
emitPOp ANF.NOTB = emitP1 NOTB
emitPOp ANF.ANDB = emitP2 ANDB
emitPOp ANF.IORB = emitP2 IORB
emitPOp ANF.FORK = \case
VArg1 i -> Fork i
_ -> internalBug "fork takes exactly one boxed argument"
Expand Down
Loading