Skip to content

Commit 06b2f04

Browse files
igstanigstan
committed
Mass commit in case my laptop bricks again...
1 parent 12e9d93 commit 06b2f04

15 files changed

+203
-33
lines changed

‎lib/core/lib.cm

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
library (0.1.0)
2+
signature LIST
3+
structure List
4+
is
5+
$/basis.cm
6+
7+
src/list.sig
8+
src/list.sml

‎lib/core/src/list.sig

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
signature LIST =
2+
sig
3+
include LIST
4+
5+
val countWhere : ('a -> bool) -> 'a list -> int
6+
7+
val foldl : 'a list -> { seed : 'b, step : 'a * 'b -> 'b } -> 'b
8+
end

‎lib/core/src/list.sml

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
structure List : LIST =
2+
struct
3+
open LIST
4+
5+
fun foldl list { seed, step } = List.foldl step seed list
6+
fun foldr list { seed, step } = List.foldr step seed list
7+
8+
fun takeWhile _ [] = []
9+
| takeWhile p (x :: xs) = if p x then x :: takeWhile p xs else []
10+
11+
fun takeUntil p = takeWhile (not o p)
12+
13+
fun countWhere predicate list =
14+
raise Fail "not implemented"
15+
16+
fun bound xs ys a b =
17+
case (xs, ys) of
18+
(x, []) => a
19+
| ([], y) => b
20+
| (_ :: xs, _ :: ys) => recur xs ys a b
21+
22+
(**
23+
* Returns the list with more elements.
24+
*)
25+
fun max a b = bound a b a b
26+
27+
(**
28+
* Returns the list with fewer elements.
29+
*)
30+
fun min a b = bound a b b a
31+
end

‎lib/core/src/other.sml

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
signature FOLDABLE =
2+
sig
3+
type 'a t
4+
type ('a, 'b) arrow = 'a -> 'b
5+
type 'a monoid = {
6+
zero : 'a,
7+
plus : 'a * 'a -> 'a
8+
}
9+
10+
val foldMap : 'm monoid -> ('a -> 'm) -> 'a t -> 'm
11+
end

‎src/class-name.sml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,6 @@
44
structure ClassName =
55
struct
66
type t = Text.t
7-
fun fromParts parts = Text.concatWith "/" parts
7+
fun fromParts parts = String.concatWith "/" parts
88
fun fromString s = s
99
end

‎src/compilable.sig

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
(* Reader Monad *)
2+
signature CONFIGURABLE =
3+
sig
4+
type 'a t
5+
type config
6+
7+
val from : (config -> 'a) -> 'a t
8+
9+
val get : key ->
10+
11+
val run : config -> 'a t -> 'a
12+
end
13+
14+
structure Configurable =
15+
struct
16+
type 'computation t = int
17+
18+
fun from f =
19+
raise Fail "not implemented"
20+
21+
fun run config =
22+
end
23+
24+
Configurable.from (fn config =>
25+
26+
)
27+
28+
signature COMPILABLE =
29+
sig
30+
type t
31+
32+
val compile : ConstPool.t -> t -> (Word8Vector.vector, ConstPool.t) Configurable.t
33+
end

‎src/index.sml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
structure Index =
2+
struct
3+
type t = int
4+
end

‎src/indexed-instr.sml

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
signature INDEXED_INSTR =
2+
sig
3+
type t
4+
5+
val index : t -> Index.t
6+
val instr : t -> Instr.t
7+
end
8+
9+
10+
structure IndexedInstr : INDEXED_INSTR =
11+
struct
12+
type t = (Index.t, Instr.t)
13+
14+
val fromPair = Fn.id
15+
16+
fun index (i, _) => i
17+
fun instr (_, i) => i
18+
end

‎src/main.sml

Lines changed: 25 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
structure Main =
22
struct
3+
open Fn.Syntax infix |>
4+
35
structure Instr = LabeledInstr
46

57
fun symbol class name descriptor = {
@@ -272,9 +274,9 @@ structure Main =
272274
]
273275
}
274276

275-
val class = Class.from {
277+
fun class name = Class.from {
276278
accessFlags = [Class.Flag.PUBLIC],
277-
thisClass = ClassName.fromString "Main",
279+
thisClass = ClassName.fromString name,
278280
superClass = ClassName.fromString "java/lang/Object",
279281
interfaces = [],
280282
attributes = [Attr.SourceFile "main.sml"],
@@ -297,9 +299,9 @@ structure Main =
297299
string o dropl isSpace o dropr isSpace o full
298300
end
299301

300-
fun java classPath className =
302+
fun java { classpath } className =
301303
let
302-
val proc = Unix.execute ("/usr/bin/java", ["-cp", classPath, className])
304+
val proc = Unix.execute ("/usr/bin/java", ["-cp", classpath, className])
303305
val output = TextIO.inputAll (Unix.textInstreamOf proc)
304306
in
305307
Unix.reap proc
@@ -308,27 +310,29 @@ structure Main =
308310

309311
fun main () =
310312
let
313+
val className = "Main"
311314
val workDir = OS.FileSys.getDir ()
312-
val bytes = Class.compile class
313-
val f = BinIO.openOut (OS.Path.joinDirFile { dir = workDir, file = "Main.class" })
314-
val _ = BinIO.output (f, bytes)
315-
val _ = BinIO.closeOut f
316-
val output = java workDir "Main"
315+
val binDir = OS.Path.joinDirFile { dir = workDir, file = "bin" }
316+
val fileName = OS.Path.joinDirFile { dir = binDir, file = className ^ ".class" }
317+
val classFile = BinIO.openOut fileName
318+
val bytes = Class.compile (class className)
319+
val _ = BinIO.output (classFile, bytes)
320+
val _ = BinIO.closeOut classFile
321+
val output = java { classpath = binDir } className
317322
in
318323
print (output ^ "\n")
319324
end
320325

321326
fun stackMap () =
322-
let
323-
val { attributes = [Attr.Code { code, ... }], ... } = nestedLoops
324-
val { offsetedInstrs, ... } = Instr.compileList ConstPool.empty code
325-
in
326-
StackLang.compileCompact
327-
(
328-
StackLang.interpret
329-
(
330-
Verifier.verify offsetedInstrs
331-
)
332-
)
333-
end
327+
case nestedLoops of
328+
| { attributes = [Attr.Code { code, ... }], ... } =>
329+
let
330+
val { offsetedInstrs, ... } = Instr.compileList ConstPool.empty code
331+
in
332+
offsetedInstrs
333+
|> Verifier.verify
334+
|> StackLang.interpret
335+
|> StackLang.compileCompact
336+
end
337+
| _ => raise Fail "not implemented"
334338
end

‎src/stack-map/stack-lang.sml

Lines changed: 16 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,12 +2,17 @@ structure StackLang =
22
struct
33
type local_index = int
44

5+
type indexed_type = {
6+
index : local_index,
7+
vtype : VerificationType.t
8+
}
9+
510
datatype t =
611
| Push of VerificationType.t
712
| Pop of VerificationType.t
8-
| Load of local_index * VerificationType.t
9-
| Store of local_index * VerificationType.t
10-
| Local of local_index * VerificationType.t
13+
| Load of local_index * VerificationType.t (* indexed_type *)
14+
| Store of local_index * VerificationType.t (* indexed_type *)
15+
| Local of local_index * VerificationType.t (* indexed_type *)
1116
| Branch of { targetOffset : int, fallsThrough : bool }
1217

1318
exception StackUnderflow
@@ -17,11 +22,15 @@ structure StackLang =
1722
case t of
1823
| Push vtype => "Push " ^ VerificationType.toString vtype
1924
| Pop vtype => "Pop " ^ VerificationType.toString vtype
20-
| Load (index, vtype) => "Load ("^ Int.toString index ^", "^ VerificationType.toString vtype ^")"
21-
| Store (index, vtype) => "Store ("^ Int.toString index ^", "^ VerificationType.toString vtype ^")"
22-
| Local (index, vtype) => "Local ("^ Int.toString index ^", "^ VerificationType.toString vtype ^")"
25+
| Load (index, vtype) =>
26+
"Load ("^ Int.toString index ^", "^ VerificationType.toString vtype ^")"
27+
| Store (index, vtype) =>
28+
"Store ("^ Int.toString index ^", "^ VerificationType.toString vtype ^")"
29+
| Local (index, vtype) =>
30+
"Local ("^ Int.toString index ^", "^ VerificationType.toString vtype ^")"
2331
| Branch { targetOffset, fallsThrough } =>
24-
"Branch { targetOffset = "^ Int.toString targetOffset ^", fallsThrough = "^ Bool.toString fallsThrough ^" }"
32+
"Branch { targetOffset = "^ Int.toString targetOffset
33+
^", fallsThrough = "^ Bool.toString fallsThrough ^" }"
2534

2635
fun interpret instrs =
2736
let

0 commit comments

Comments
 (0)