Skip to content

Commit

Permalink
Add primitives for Char.ord/chr
Browse files Browse the repository at this point in the history
  • Loading branch information
@minoki
minoki committed Sep 16, 2023
1 parent 263c600 commit 55ee768
Show file tree
Hide file tree
Showing 8 changed files with 144 additions and 6 deletions.
4 changes: 2 additions & 2 deletions lib/lunarml/ml/basis/js-common/char-1.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,11 +42,11 @@ type string = string
val minChar = #"\000"
val maxChar = #"\255"
val maxOrd = 255
val ord : char -> int = Unsafe.cast
val ord : char -> int = fn x => _primCall "Char.ord" (x)
val chr : int -> char = fn x => if x < 0 orelse x > 255 then
raise Chr
else
Unsafe.cast x : char
_primCall "Char.chr.unchecked" (x)
fun succ c = chr (ord c + 1)
fun pred c = chr (ord c - 1)
fun compare (x : char, y : char) = if x = y then
Expand Down
4 changes: 2 additions & 2 deletions lib/lunarml/ml/basis/lua/char-1.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,11 +42,11 @@ type string = string
val minChar = #"\000"
val maxChar = #"\255"
val maxOrd = 255
val ord : char -> int = Unsafe.cast
val ord : char -> int = fn x => _primCall "Char.ord" (x)
val chr : int -> char = fn x => if x < 0 orelse x > 255 then
raise Chr
else
Unsafe.cast x
_primCall "Char.chr.unchecked" (x)
fun succ c = chr (ord c + 1)
fun pred c = chr (ord c - 1)
fun compare (x : char, y : char) = if x = y then
Expand Down
4 changes: 2 additions & 2 deletions lib/lunarml/ml/basis/luajit/char-1.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,11 +42,11 @@ type string = string
val minChar = #"\000"
val maxChar = #"\255"
val maxOrd = 255
val ord : char -> int = Unsafe.cast
val ord : char -> int = fn x => _primCall "Char.ord" (x)
val chr : int -> char = fn x => if x < 0 orelse x > 255 then
raise Chr
else
Unsafe.cast x
_primCall "Char.chr.unchecked" (x)
fun succ c = chr (ord c + 1)
fun pred c = chr (ord c - 1)
fun compare (x : char, y : char) = if x = y then
Expand Down
8 changes: 8 additions & 0 deletions src/codegen-js.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -421,11 +421,19 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
| Primitives.Char_GT => doBinaryOp (J.GT, PURE)
| Primitives.Char_LE => doBinaryOp (J.LE, PURE)
| Primitives.Char_GE => doBinaryOp (J.GE, PURE)
| Primitives.Char_ord Primitives.I32 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char_ord Primitives.I54 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char_chr_unchecked Primitives.I32 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char_chr_unchecked Primitives.I54 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char16_EQUAL => doBinaryOp (J.EQUAL, PURE)
| Primitives.Char16_LT => doBinaryOp (J.LT, PURE)
| Primitives.Char16_GT => doBinaryOp (J.GT, PURE)
| Primitives.Char16_LE => doBinaryOp (J.LE, PURE)
| Primitives.Char16_GE => doBinaryOp (J.GE, PURE)
| Primitives.Char16_ord Primitives.I32 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char16_ord Primitives.I54 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char16_chr_unchecked Primitives.I54 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.Char16_chr_unchecked Primitives.I32 => doUnaryExp (fn a => a, PURE) (* no-op *)
| Primitives.String_EQUAL => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_String_EQUAL"), vector [a, b]), PURE)
| Primitives.String_LT => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_String_LT"), vector [a, b]), PURE)
| Primitives.String_HAT => doBinaryExp (fn (a, b) => J.CallExp (J.VarExp (J.PredefinedId "_String_append"), vector [a, b]), PURE)
Expand Down
14 changes: 14 additions & 0 deletions src/codegen-lua.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -671,6 +671,20 @@ fun doDecs (ctx, env, defaultCont, decs, finalExp, revStats : L.Stat list)
| Primitives.Char_GT => doBinaryOp (L.GT, PURE)
| Primitives.Char_LE => doBinaryOp (L.LE, PURE)
| Primitives.Char_GE => doBinaryOp (L.GE, PURE)
| Primitives.Char_ord w =>
(case (#targetLuaVersion ctx, w) of
(LUA5_3, Primitives.INT) => doUnaryExp (fn a => a, PURE) (* no-op *)
| (LUAJIT, Primitives.I32) => doUnaryExp (fn a => a, PURE) (* no-op *)
| (LUAJIT, Primitives.I54) => doUnaryExp (fn a => a, PURE) (* no-op *)
| _ => raise CodeGenError ("primop " ^ Primitives.toString prim ^ " is not supported on this target")
)
| Primitives.Char_chr_unchecked w =>
(case (#targetLuaVersion ctx, w) of
(LUA5_3, Primitives.INT) => doUnaryExp (fn a => a, PURE) (* no-op *)
| (LUAJIT, Primitives.I32) => doUnaryExp (fn a => a, PURE) (* no-op *)
| (LUAJIT, Primitives.I54) => doUnaryExp (fn a => a, PURE) (* no-op *)
| _ => raise CodeGenError ("primop " ^ Primitives.toString prim ^ " is not supported on this target")
)
| Primitives.String_EQUAL => doBinaryOp (L.EQUAL, PURE)
| Primitives.String_LT => doBinaryOp (L.LT, PURE)
| Primitives.String_GT => doBinaryOp (L.GT, PURE)
Expand Down
12 changes: 12 additions & 0 deletions src/cps.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1331,6 +1331,18 @@ fun simplifySimpleExp (env : value_info TypedSyntax.VIdMap.map, C.Record fields)
NOT_SIMPLIFIED
else
NOT_SIMPLIFIED
| (F.PrimCall (P.Char_ord w), [C.CharConst c]) => VALUE (C.IntConst (w, Int.toLarge (Char.ord c)))
| (F.PrimCall (P.Char_chr_unchecked w), [C.IntConst (w', c)]) =>
if w = w' andalso 0 <= c andalso c <= 255 then
VALUE (C.CharConst (Char.chr (Int.fromLarge c)))
else
NOT_SIMPLIFIED
| (F.PrimCall (P.Char16_ord w), [C.Char16Const c]) => VALUE (C.IntConst (w, Int.toLarge c))
| (F.PrimCall (P.Char16_chr_unchecked w), [C.IntConst (w', c)]) =>
if w = w' andalso 0 <= c andalso c <= 0xffff then
VALUE (C.Char16Const (Int.fromLarge c))
else
NOT_SIMPLIFIED
| _ => NOT_SIMPLIFIED
)
| simplifySimpleExp (env, C.ExnTag _) = NOT_SIMPLIFIED
Expand Down
28 changes: 28 additions & 0 deletions src/primitives.lua
View file
Original file line number Diff line number Diff line change
Expand Up @@ -554,6 +554,20 @@ do
mayraise = false,
discardable = true,
},
{
name = "Char.ord{.i}",
srcname = "Char_ord",
type = { vars = {}, args = {char}, result = intA },
mayraise = false,
discardable = true,
},
{
name = "Char.chr.unchecked{.i}",
srcname = "Char_chr_unchecked",
type = { vars = {}, args = {intA}, result = char },
mayraise = false,
discardable = true,
},
{
name = "Char16.=",
srcname = "Char16_EQUAL",
Expand Down Expand Up @@ -589,6 +603,20 @@ do
mayraise = false,
discardable = true,
},
{
name = "Char16.ord{.i}",
srcname = "Char16_ord",
type = { vars = {}, args = {char16}, result = intA },
mayraise = false,
discardable = true,
},
{
name = "Char16.chr.unchecked{.i}",
srcname = "Char16_chr_unchecked",
type = { vars = {}, args = {intA}, result = char16 },
mayraise = false,
discardable = true,
},
{
name = "String.=",
srcname = "String_EQUAL",
Expand Down
76 changes: 76 additions & 0 deletions src/primitives.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -73,11 +73,15 @@ datatype PrimOp = EQUAL (* = *)
| Char_LE (* Char.<= *)
| Char_GT (* Char.> *)
| Char_GE (* Char.>= *)
| Char_ord of int_width (* Char.ord{.i} *)
| Char_chr_unchecked of int_width (* Char.chr.unchecked{.i} *)
| Char16_EQUAL (* Char16.= *)
| Char16_LT (* Char16.< *)
| Char16_LE (* Char16.<= *)
| Char16_GT (* Char16.> *)
| Char16_GE (* Char16.>= *)
| Char16_ord of int_width (* Char16.ord{.i} *)
| Char16_chr_unchecked of int_width (* Char16.chr.unchecked{.i} *)
| String_EQUAL (* String.= *)
| String_LT (* String.< *)
| String_LE (* String.<= *)
Expand Down Expand Up @@ -412,11 +416,31 @@ fun toString EQUAL = "="
| toString Char_LE = "Char.<="
| toString Char_GT = "Char.>"
| toString Char_GE = "Char.>="
| toString (Char_ord INT) = "Char.ord"
| toString (Char_ord I32) = "Char.ord.i32"
| toString (Char_ord I54) = "Char.ord.i54"
| toString (Char_ord I64) = "Char.ord.i64"
| toString (Char_ord INT_INF) = "Char.ord.intInf"
| toString (Char_chr_unchecked INT) = "Char.chr.unchecked"
| toString (Char_chr_unchecked I32) = "Char.chr.unchecked.i32"
| toString (Char_chr_unchecked I54) = "Char.chr.unchecked.i54"
| toString (Char_chr_unchecked I64) = "Char.chr.unchecked.i64"
| toString (Char_chr_unchecked INT_INF) = "Char.chr.unchecked.intInf"
| toString Char16_EQUAL = "Char16.="
| toString Char16_LT = "Char16.<"
| toString Char16_LE = "Char16.<="
| toString Char16_GT = "Char16.>"
| toString Char16_GE = "Char16.>="
| toString (Char16_ord INT) = "Char16.ord"
| toString (Char16_ord I32) = "Char16.ord.i32"
| toString (Char16_ord I54) = "Char16.ord.i54"
| toString (Char16_ord I64) = "Char16.ord.i64"
| toString (Char16_ord INT_INF) = "Char16.ord.intInf"
| toString (Char16_chr_unchecked INT) = "Char16.chr.unchecked"
| toString (Char16_chr_unchecked I32) = "Char16.chr.unchecked.i32"
| toString (Char16_chr_unchecked I54) = "Char16.chr.unchecked.i54"
| toString (Char16_chr_unchecked I64) = "Char16.chr.unchecked.i64"
| toString (Char16_chr_unchecked INT_INF) = "Char16.chr.unchecked.intInf"
| toString String_EQUAL = "String.="
| toString String_LT = "String.<"
| toString String_LE = "String.<="
Expand Down Expand Up @@ -783,11 +807,31 @@ fun fromString "=" = SOME EQUAL
| fromString "Char.<=" = SOME Char_LE
| fromString "Char.>" = SOME Char_GT
| fromString "Char.>=" = SOME Char_GE
| fromString "Char.ord" = SOME (Char_ord INT)
| fromString "Char.ord.i32" = SOME (Char_ord I32)
| fromString "Char.ord.i54" = SOME (Char_ord I54)
| fromString "Char.ord.i64" = SOME (Char_ord I64)
| fromString "Char.ord.intInf" = SOME (Char_ord INT_INF)
| fromString "Char.chr.unchecked" = SOME (Char_chr_unchecked INT)
| fromString "Char.chr.unchecked.i32" = SOME (Char_chr_unchecked I32)
| fromString "Char.chr.unchecked.i54" = SOME (Char_chr_unchecked I54)
| fromString "Char.chr.unchecked.i64" = SOME (Char_chr_unchecked I64)
| fromString "Char.chr.unchecked.intInf" = SOME (Char_chr_unchecked INT_INF)
| fromString "Char16.=" = SOME Char16_EQUAL
| fromString "Char16.<" = SOME Char16_LT
| fromString "Char16.<=" = SOME Char16_LE
| fromString "Char16.>" = SOME Char16_GT
| fromString "Char16.>=" = SOME Char16_GE
| fromString "Char16.ord" = SOME (Char16_ord INT)
| fromString "Char16.ord.i32" = SOME (Char16_ord I32)
| fromString "Char16.ord.i54" = SOME (Char16_ord I54)
| fromString "Char16.ord.i64" = SOME (Char16_ord I64)
| fromString "Char16.ord.intInf" = SOME (Char16_ord INT_INF)
| fromString "Char16.chr.unchecked" = SOME (Char16_chr_unchecked INT)
| fromString "Char16.chr.unchecked.i32" = SOME (Char16_chr_unchecked I32)
| fromString "Char16.chr.unchecked.i54" = SOME (Char16_chr_unchecked I54)
| fromString "Char16.chr.unchecked.i64" = SOME (Char16_chr_unchecked I64)
| fromString "Char16.chr.unchecked.intInf" = SOME (Char16_chr_unchecked INT_INF)
| fromString "String.=" = SOME String_EQUAL
| fromString "String.<" = SOME String_LT
| fromString "String.<=" = SOME String_LE
Expand Down Expand Up @@ -994,11 +1038,15 @@ fun mayRaise (Int_PLUS INT_INF) = false
| mayRaise Char_LE = false
| mayRaise Char_GT = false
| mayRaise Char_GE = false
| mayRaise (Char_ord _) = false
| mayRaise (Char_chr_unchecked _) = false
| mayRaise Char16_EQUAL = false
| mayRaise Char16_LT = false
| mayRaise Char16_LE = false
| mayRaise Char16_GT = false
| mayRaise Char16_GE = false
| mayRaise (Char16_ord _) = false
| mayRaise (Char16_chr_unchecked _) = false
| mayRaise String_EQUAL = false
| mayRaise String_LT = false
| mayRaise String_LE = false
Expand Down Expand Up @@ -1172,11 +1220,15 @@ fun isDiscardable (Int_PLUS INT_INF) = true
| isDiscardable Char_LE = true
| isDiscardable Char_GT = true
| isDiscardable Char_GE = true
| isDiscardable (Char_ord _) = true
| isDiscardable (Char_chr_unchecked _) = true
| isDiscardable Char16_EQUAL = true
| isDiscardable Char16_LT = true
| isDiscardable Char16_LE = true
| isDiscardable Char16_GT = true
| isDiscardable Char16_GE = true
| isDiscardable (Char16_ord _) = true
| isDiscardable (Char16_chr_unchecked _) = true
| isDiscardable String_EQUAL = true
| isDiscardable String_LT = true
| isDiscardable String_LE = true
Expand Down Expand Up @@ -1323,6 +1375,10 @@ fun fixIntWord { int, word }
| Word_xorb a1 => Word_xorb (fixWord a1)
| Word_LSHIFT_unchecked (a1, a2) => Word_LSHIFT_unchecked (fixWord a1, fixWord a2)
| Word_RSHIFT_unchecked (a1, a2) => Word_RSHIFT_unchecked (fixWord a1, fixWord a2)
| Char_ord a1 => Char_ord (fixInt a1)
| Char_chr_unchecked a1 => Char_chr_unchecked (fixInt a1)
| Char16_ord a1 => Char16_ord (fixInt a1)
| Char16_chr_unchecked a1 => Char16_chr_unchecked (fixInt a1)
| String_size a1 => String_size (fixInt a1)
| String16_size a1 => String16_size (fixInt a1)
| Vector_length a1 => Vector_length (fixInt a1)
Expand Down Expand Up @@ -1618,11 +1674,31 @@ fun typeOf Primitives.EQUAL = { vars = [(tyVarEqA, [IsEqType])], args = vector [
| typeOf Primitives.Char_LE = { vars = [], args = vector [char, char], result = bool }
| typeOf Primitives.Char_GT = { vars = [], args = vector [char, char], result = bool }
| typeOf Primitives.Char_GE = { vars = [], args = vector [char, char], result = bool }
| typeOf (Primitives.Char_ord Primitives.INT) = { vars = [], args = vector [char], result = int }
| typeOf (Primitives.Char_ord Primitives.I32) = { vars = [], args = vector [char], result = int32 }
| typeOf (Primitives.Char_ord Primitives.I54) = { vars = [], args = vector [char], result = int54 }
| typeOf (Primitives.Char_ord Primitives.I64) = { vars = [], args = vector [char], result = int64 }
| typeOf (Primitives.Char_ord Primitives.INT_INF) = { vars = [], args = vector [char], result = intInf }
| typeOf (Primitives.Char_chr_unchecked Primitives.INT) = { vars = [], args = vector [int], result = char }
| typeOf (Primitives.Char_chr_unchecked Primitives.I32) = { vars = [], args = vector [int32], result = char }
| typeOf (Primitives.Char_chr_unchecked Primitives.I54) = { vars = [], args = vector [int54], result = char }
| typeOf (Primitives.Char_chr_unchecked Primitives.I64) = { vars = [], args = vector [int64], result = char }
| typeOf (Primitives.Char_chr_unchecked Primitives.INT_INF) = { vars = [], args = vector [intInf], result = char }
| typeOf Primitives.Char16_EQUAL = { vars = [], args = vector [char16, char16], result = bool }
| typeOf Primitives.Char16_LT = { vars = [], args = vector [char16, char16], result = bool }
| typeOf Primitives.Char16_LE = { vars = [], args = vector [char16, char16], result = bool }
| typeOf Primitives.Char16_GT = { vars = [], args = vector [char16, char16], result = bool }
| typeOf Primitives.Char16_GE = { vars = [], args = vector [char16, char16], result = bool }
| typeOf (Primitives.Char16_ord Primitives.INT) = { vars = [], args = vector [char16], result = int }
| typeOf (Primitives.Char16_ord Primitives.I32) = { vars = [], args = vector [char16], result = int32 }
| typeOf (Primitives.Char16_ord Primitives.I54) = { vars = [], args = vector [char16], result = int54 }
| typeOf (Primitives.Char16_ord Primitives.I64) = { vars = [], args = vector [char16], result = int64 }
| typeOf (Primitives.Char16_ord Primitives.INT_INF) = { vars = [], args = vector [char16], result = intInf }
| typeOf (Primitives.Char16_chr_unchecked Primitives.INT) = { vars = [], args = vector [int], result = char16 }
| typeOf (Primitives.Char16_chr_unchecked Primitives.I32) = { vars = [], args = vector [int32], result = char16 }
| typeOf (Primitives.Char16_chr_unchecked Primitives.I54) = { vars = [], args = vector [int54], result = char16 }
| typeOf (Primitives.Char16_chr_unchecked Primitives.I64) = { vars = [], args = vector [int64], result = char16 }
| typeOf (Primitives.Char16_chr_unchecked Primitives.INT_INF) = { vars = [], args = vector [intInf], result = char16 }
| typeOf Primitives.String_EQUAL = { vars = [], args = vector [string, string], result = bool }
| typeOf Primitives.String_LT = { vars = [], args = vector [string, string], result = bool }
| typeOf Primitives.String_LE = { vars = [], args = vector [string, string], result = bool }
Expand Down

0 comments on commit 55ee768

Please sign in to comment.