Skip to content

Commit

Permalink
Erase unused variables and fix several typos
Browse files Browse the repository at this point in the history
  • Loading branch information
@minoki
minoki committed Jan 27, 2024
1 parent 2a9ad54 commit fbe8852
Show file tree
Hide file tree
Showing 29 changed files with 1,485 additions and 1,523 deletions.
2 changes: 1 addition & 1 deletion Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@ sources = \
src/main-default.sml

typecheck: src/lunarml.mlb $(sources)
mlton -stop tc $<
mlton -stop tc -default-ann "warnUnused true" $<

bin/lunarml: src/lunarml.mlb $(sources)
mlton -output $@ $<
Expand Down
12 changes: 6 additions & 6 deletions pluto/parser-combinator.fun
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,14 +23,14 @@ fun showError ({ pos, messages } : parseError) = S.showPos pos ^ ": " ^ String.c
| Expected s => "expected " ^ s
| Unexpected s => "unexpected " ^ s
) messages)
datatype 'a parserResult = Ok' of 'a * bool * internalState
| Err of bool * parseError
datatype 'a parserResult = Ok' of 'a * (* consumed? *) bool * internalState
| Err of (* consumed? *) bool * parseError
type 'a parser = internalState -> 'a parserResult
datatype 'a result = ParseError of string
| Ok of 'a * state
fun runParser p state0 name stream = case p { stream = stream, pos = Stream.initialPos name, user = state0 } of
Ok' (result, consumed, { stream, pos, user }) => Ok (result, user)
| Err (consumed, e) => ParseError (showError e)
Ok' (result, _, { stream = _, pos = _, user }) => Ok (result, user)
| Err (_, e) => ParseError (showError e)
fun delay p = fn s => p () s
fun fix f = let fun p s = f p s
in p
Expand Down Expand Up @@ -114,7 +114,7 @@ fun many p = fn s => case p s of
Ok' (xs, _, s) => Ok' (x :: xs, true, s)
| Err (_, e) => Err (true, e)
)
| Ok' (x, false, s) => Err (false, { pos = #pos s, messages = [Message "many: combinator 'many' is applied to a parser that accepts an empty string"] })
| Ok' (_, false, s) => Err (false, { pos = #pos s, messages = [Message "many: combinator 'many' is applied to a parser that accepts an empty string"] })
| Err (false, _) => Ok' ([], false, s)
| Err (true, e) => Err (true, e)
(* fun many p = (p >>= (fn x => many p >>= (fn xs => pure (x :: xs)))) <|> pure [] *)
Expand All @@ -133,7 +133,7 @@ fun optional_ p = fn s => case p s of
| Err (false, _) => Ok' ((), false, s)
| Err (true, e) => Err (true, e)
fun notFollowedBy p = fn s => case p s of
Ok' (x, _, _) => Err (false, { pos = #pos s, messages = [Unexpected "token"] }) (* unexpected 'x' *)
Ok' (_, _, _) => Err (false, { pos = #pos s, messages = [Unexpected "token"] }) (* unexpected 'x' *)
| Err (_, _) => Ok' ((), false, s)
val eof = notFollowedBy anyToken <?> "end of input"
fun between (open_, close) p = (open_ >> p) <* close
Expand Down
40 changes: 19 additions & 21 deletions src/codegen-js.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,6 @@ structure F = FSyntax
structure C = CSyntax
structure J = JsSyntax

fun LetStat (vid, exp) = J.LetStat (vector [(vid, SOME exp)])
fun ConstStat (vid, exp) = J.ConstStat (vector [(vid, exp)])

val builtinsDirect
Expand Down Expand Up @@ -168,7 +167,7 @@ fun doValue (ctx, env : Env) (C.Var vid) = (case TypedSyntax.VIdMap.find (#subst
| doValue _ C.Nil = J.ConstExp J.Null (* empty list *)
| doValue _ (C.BoolConst false) = J.ConstExp J.False
| doValue _ (C.BoolConst true) = J.ConstExp J.True
| doValue _ (C.IntConst (Primitives.INT, x)) = raise Fail "NativeIntConst is not supported by JavaScript backend"
| doValue _ (C.IntConst (Primitives.INT, _)) = raise Fail "NativeIntConst is not supported by JavaScript backend"
| doValue _ (C.IntConst (Primitives.I32, x)) = if x < 0 then
J.UnaryExp (J.NEGATE, J.ConstExp (J.Numeral (LargeInt.toString (~ x))))
else
Expand All @@ -185,7 +184,7 @@ fun doValue (ctx, env : Env) (C.Var vid) = (case TypedSyntax.VIdMap.find (#subst
J.UnaryExp (J.NEGATE, J.ConstExp (J.Numeral (LargeInt.toString (~ x) ^ "n")))
else
J.ConstExp (J.Numeral (LargeInt.toString x ^ "n"))
| doValue _ (C.WordConst (Primitives.WORD, x)) = raise Fail "NativeWordConst is not supported by JavaScript backend"
| doValue _ (C.WordConst (Primitives.WORD, _)) = raise Fail "NativeWordConst is not supported by JavaScript backend"
| doValue _ (C.WordConst (Primitives.W32, x)) = J.ConstExp (J.Numeral ("0x" ^ LargeInt.fmt StringCvt.HEX x))
| doValue _ (C.WordConst (Primitives.W64, x)) = J.ConstExp (J.Numeral ("0x" ^ LargeInt.fmt StringCvt.HEX x ^ "n"))
| doValue _ (C.CharConst x) = J.ConstExp (J.Numeral (Int.toString (ord x)))
Expand All @@ -207,12 +206,14 @@ fun genSymNamed (ctx : Context, name) = let val n = !(#nextJsId ctx)
in TypedSyntax.MkVId (name, n)
end
fun genSym ctx = genSymNamed (ctx, "tmp")
(*
fun genExnContSym (ctx : Context) = let val n = !(#nextJsId ctx)
val _ = #nextJsId ctx := n + 1
in CSyntax.CVar.fromInt n
end
*)

fun applyCont (ctx : Context, env : Env, cont, args)
fun applyCont (_ : Context, env : Env, cont, args)
= case C.CVarMap.find (#continuations env, cont) of
SOME (BREAK_TO { label, which, params }) => let val (params', args') = ListPair.foldrEq (fn (SOME p, a, (pp, aa)) => (p :: pp, a :: aa)
| (NONE, _, acc) => acc
Expand Down Expand Up @@ -242,9 +243,9 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
= (case VectorSlice.getItem decs of
NONE => List.revAppend (revStats, doCExp ctx env finalExp)
| SOME (dec, decs) =>
let fun pure (NONE, exp) = doDecs (ctx, env, decs, finalExp, revStats)
let fun pure (NONE, _) = doDecs (ctx, env, decs, finalExp, revStats)
| pure (SOME result, exp) = doDecs (ctx, env, decs, finalExp, ConstStat (result, exp) :: revStats)
fun discardable (NONE, exp) = doDecs (ctx, env, decs, finalExp, revStats)
fun discardable (NONE, _) = doDecs (ctx, env, decs, finalExp, revStats)
| discardable (SOME result, exp) = doDecs (ctx, env, decs, finalExp, ConstStat (result, exp) :: revStats)
fun impure (NONE, exp) = doDecs (ctx, env, decs, finalExp, J.ExpStat exp :: revStats)
| impure (SOME result, exp) = doDecs (ctx, env, decs, finalExp, ConstStat (result, exp) :: revStats)
Expand Down Expand Up @@ -308,13 +309,10 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
val payload = doValue (ctx, env) payload
in pure (result, J.NewExp (tag, vector [payload]))
end
| C.ValDec { exp = C.PrimOp { primOp = F.RaiseOp (span as { start as { file, line, column }, ... }), tyargs = _, args = [exp] }, result } =>
| C.ValDec { exp = C.PrimOp { primOp = F.RaiseOp (_ (* span as { start as { file, line, column }, ... } *)), tyargs = _, args = [exp] }, result = _ } =>
List.rev (J.ThrowStat (doValue (ctx, env) exp) :: revStats) (* TODO: location information *)
| C.ValDec { exp = C.PrimOp { primOp = F.PrimCall prim, tyargs, args }, result } =>
let fun ConstStatOrExpStat e = case result of
SOME result => ConstStat (result, e)
| NONE => J.ExpStat e
fun doNullary f = case args of
| C.ValDec { exp = C.PrimOp { primOp = F.PrimCall prim, tyargs = _, args }, result } =>
let fun doNullary f = case args of
[] => f ()
| _ => raise CodeGenError ("primop " ^ Primitives.toString prim ^ ": invalid number of arguments")
fun doNullaryExp (f, purity) = doNullary (fn () =>
Expand Down Expand Up @@ -530,12 +528,12 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
impure (result, J.CallExp (J.IndexExp (doValue (ctx, env) obj, doValue (ctx, env) name), Vector.map (doValue (ctx, env)) (vector args)))
| C.ValDec { exp = C.PrimOp { primOp = F.JsNewOp, tyargs = _, args = ctor :: args }, result } =>
impure (result, J.NewExp (doValue (ctx, env) ctor, Vector.map (doValue (ctx, env)) (vector args)))
| C.ValDec { exp = C.PrimOp { primOp, tyargs = _, args = _ }, result } =>
| C.ValDec { exp = C.PrimOp { primOp, tyargs = _, args = _ }, result = _ } =>
raise CodeGenError ("primop " ^ Printer.build (FPrinter.doPrimOp primOp) ^ " is not supported on JavaScript backend")
| C.ValDec { exp = C.Record fields, result } =>
let val fields = Syntax.LabelMap.foldri (fn (label, v, acc) => (label, doValue (ctx, env) v) :: acc) [] fields
fun isTuple (_, []) = true
| isTuple (i, (Syntax.NumericLabel n, x) :: xs) = i = n andalso isTuple (i + 1, xs)
| isTuple (i, (Syntax.NumericLabel n, _) :: xs) = i = n andalso isTuple (i + 1, xs)
| isTuple _ = false
val exp = if isTuple (1, fields) then
J.ArrayExp (vector (List.map #2 fields))
Expand All @@ -557,7 +555,7 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
end
| NONE => doDecs (ctx, env, decs, finalExp, revStats)
)
| C.ValDec { exp = C.Projection { label, record, fieldTypes }, result } =>
| C.ValDec { exp = C.Projection { label, record, fieldTypes = _ }, result } =>
let val label = case label of
Syntax.NumericLabel n => J.ConstExp (J.Numeral (Int.toString (n - 1))) (* non-negative *)
| Syntax.IdentifierLabel s => J.ConstExp (J.asciiStringAsWide s)
Expand Down Expand Up @@ -641,7 +639,7 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
DIRECT_STYLE => false
| CPS => List.exists (fn (name, _, _) => CpsAnalyze.escapesTransitively (#contEscapeMap ctx, name)) defs
in if escape then
let val env' = { continuations = List.foldl (fn ((name, params, _), e) => C.CVarMap.insert (e, name, TAILCALL name)) (#continuations env) defs
let val env' = { continuations = List.foldl (fn ((name, _, _), e) => C.CVarMap.insert (e, name, TAILCALL name)) (#continuations env) defs
, subst = #subst env
}
val (decs', assignments) = List.foldr (fn ((name, params, body), (decs, assignments)) =>
Expand All @@ -654,7 +652,7 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
| NO_INIT
val init = case (VectorSlice.isEmpty decs, finalExp) of
(true, C.AppCont { applied, args }) =>
let fun find (i, []) = NO_INIT
let fun find (_, []) = NO_INIT
| find (i, (name, params, _) :: xs) = if name = applied then
INIT_WITH_VALUES (i, params, args)
else
Expand All @@ -667,7 +665,7 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
| NO_WHICH of C.CVar * (C.Var option) list * C.CExp
val maxargs = List.foldl (fn ((_, params, _), n) => Int.max (n, List.length (List.filter Option.isSome params))) 0 defs
val commonParams = List.tabulate (maxargs, fn _ => genSym ctx)
fun mapCommonParams params = List.rev (#2 (List.foldl (fn (SOME p, (c :: rest, acc)) => (rest, SOME c :: acc)
fun mapCommonParams params = List.rev (#2 (List.foldl (fn (SOME _, (c :: rest, acc)) => (rest, SOME c :: acc)
| (_, (rest, acc)) => (rest, NONE :: acc)
) (commonParams, []) params))
val (optWhich, vars) = case defs of
Expand Down Expand Up @@ -719,7 +717,7 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
, initAndRest
@ [ J.LoopStat ( SOME loopLabel
, case optWhich of
NO_WHICH (name, params, body) =>
NO_WHICH (_, params, body) =>
let val dec = let val defs = ListPair.map (fn (p, c) => (p, J.VarExp (J.UserDefinedId c))) (List.mapPartial (fn x => x) params, commonParams)
in if List.null defs then
[]
Expand All @@ -730,7 +728,7 @@ fun doDecs (ctx, env, decs, finalExp, revStats)
end
| NEED_WHICH which' =>
vector [ J.SwitchStat ( J.VarExp which'
, #2 (List.foldr (fn ((name, params, body), (i, cases)) =>
, #2 (List.foldr (fn ((_, params, body), (i, cases)) =>
let val i = i - 1
val dec = let val defs = ListPair.map (fn (p, c) => (p, J.VarExp (J.UserDefinedId c))) (List.mapPartial (fn x => x) params, commonParams)
in if List.null defs then
Expand Down Expand Up @@ -834,7 +832,7 @@ and doCExp (ctx : Context) (env : Env) (C.Let { decs, cont }) : J.Stat list
end
end
)
| doCExp ctx env C.Unreachable = []
| doCExp _ _ C.Unreachable = []

fun doProgramDirect ctx cont cexp
= let val label = CVarToJs cont
Expand Down
Loading

0 comments on commit fbe8852

Please sign in to comment.