Skip to content

Commit 87750e7

Browse files
zmactepzmactep
committed
Merge branch 'master' of github.com:lambda-llama/icfpc2014
2 parents 78a8206 + 68ba799 commit 87750e7

File tree

7 files changed

+54
-62
lines changed

7 files changed

+54
-62
lines changed

‎_oasis

+2-2
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,8 @@ Library llama_man
2121
Modules: Gcc_types,
2222
Gcc_compiler
2323
if flag(strict)
24-
NativeOpt: -w @a -warn-error -a
25-
ByteOpt: -w @a -warn-error -a
24+
NativeOpt: -w @a-4 -warn-error -a
25+
ByteOpt: -w @a-4 -warn-error -a
2626
BuildDepends: core_kernel
2727
sexplib,
2828
sexplib.syntax,

‎lib_src/gcc_compiler.ml

+32-35
Original file line numberDiff line numberDiff line change
@@ -94,47 +94,44 @@ and compile_func id formals expr {functions; env} =
9494
add_fn id code RTN {functions = fns1; env=env}
9595

9696
let compile expr =
97-
let (code, {functions}) = compile_expr expr initial_state in
98-
code @ [RTN] @ List.concat functions
99-
100-
let rec assemble_rec instructions address_map =
101-
let resolve addr = Hashtbl.find_exn address_map addr in
102-
match instructions with
103-
| [] -> ""
104-
| (x :: xs) ->
105-
let cmd = match x with
106-
| LDC c -> sprintf "LDC %d" c
107-
| ADD -> "ADD"
108-
| SUB -> "SUB"
109-
| MUL -> "MUL"
110-
| DIV -> "DIV"
111-
| CEQ -> "CEQ"
112-
| CGT -> "CGT"
113-
| CGTE -> "CGTE"
114-
| CONS -> "CONS"
115-
| RTN -> "RTN"
116-
| JOIN -> "JOIN"
117-
| CAR -> "CAR"
118-
| CDR -> "CDR"
119-
| LABEL _ -> ""
120-
| COMMENT c -> sprintf "; %s" c
121-
| LD (i, j) -> sprintf "LD %d %d" i j
122-
| SEL (addr1, addr2) ->
123-
sprintf "SEL %d %d" (resolve addr1) (resolve addr2)
124-
| LDF addr -> sprintf "LDF %d" (resolve addr)
125-
| AP n -> sprintf "AP %d" n
126-
in
127-
128-
let indent = if cmd = "" then "" else " " in
129-
indent ^ cmd ^ sprintf "\n%s" (assemble_rec xs address_map)
97+
let (code, state) = compile_expr expr initial_state in
98+
code @ [RTN] @ List.concat state.functions
13099

131100
let assemble instructions =
132101
let address_map = Hashtbl.Poly.create ~size:4 () in
133102
let (_ : int) = List.fold_left instructions
134103
~init:0
135104
~f:(fun acc inst->
136105
begin match inst with
137-
|LABEL l -> Hashtbl.add_exn address_map ~key:l ~data:acc
106+
| LABEL l -> Hashtbl.add_exn address_map ~key:l ~data:acc
138107
| _ -> ()
139108
end; if is_phony inst then acc else succ acc)
140-
in assemble_rec instructions address_map
109+
in
110+
111+
let resolve = Hashtbl.find_exn address_map in
112+
String.concat ~sep:"\n" (List.map instructions ~f:(fun instruction ->
113+
let cmd = match instruction with
114+
| LDC c -> sprintf "LDC %d" c
115+
| ADD -> "ADD"
116+
| SUB -> "SUB"
117+
| MUL -> "MUL"
118+
| DIV -> "DIV"
119+
| CEQ -> "CEQ"
120+
| CGT -> "CGT"
121+
| CGTE -> "CGTE"
122+
| CONS -> "CONS"
123+
| RTN -> "RTN"
124+
| JOIN -> "JOIN"
125+
| CAR -> "CAR"
126+
| CDR -> "CDR"
127+
| LABEL _ -> ""
128+
| COMMENT c -> "; " ^ c
129+
| LD (i, j) -> sprintf "LD %d %d" i j
130+
| SEL (addr1, addr2) -> sprintf "SEL %d %d" (resolve addr1) (resolve addr2)
131+
| LDF addr -> sprintf "LDF %d" (resolve addr)
132+
| AP n -> sprintf "AP %d" n
133+
| _ ->
134+
let sexp = Sexp.to_string (sexp_of_instruction instruction) in
135+
failwithf "unsupported instruction %s" sexp ()
136+
and indent = if is_phony instruction then "" else " " in
137+
indent ^ cmd))

‎lib_src/gcc_types.ml

+5-6
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,6 @@ open Core_kernel.Std
22

33
module Address = Unique_id.Int(Unit)
44

5-
type address = Address.t
6-
75
type instruction =
86
| LDC of int (* load constant *)
97
| LD of int * int (* load from environment *)
@@ -18,22 +16,23 @@ type instruction =
1816
| CONS (* allocate a CONS cell *)
1917
| CAR (* first *)
2018
| CDR (* second *)
21-
| SEL of address * address (* conditional branch *)
19+
| SEL of Address.t * Address.t (* conditional branch *)
2220
| JOIN (* return from branch *)
23-
| LDF of address (* load function *)
21+
| LDF of Address.t (* load function *)
2422
| AP of int (* call function *)
2523
| RTN (* return from function call *)
2624
| DUM of int (* create empty env frame *)
2725
| RAP of int (* recursive environment call function *)
2826
| STOP (* terminate co-processor execution *)
29-
| TSEL of address * address (* tail-call conditional branch *)
27+
| TSEL of Address.t * Address.t (* tail-call conditional branch *)
3028
| TAP of int (* tail-call function *)
3129
| TRAP of int (* recursive env tail-call function *)
3230
| ST of int * int (* store to env *)
3331
| DBG (* printf debugging *)
3432
| BRK (* breakpoint debugging *)
35-
| LABEL of address
33+
| LABEL of Address.t
3634
| COMMENT of string
35+
with sexp_of
3736

3837
let is_phony = function
3938
| LABEL _ | COMMENT _ -> true

‎lib_test/gcc_test.ml

+2-6
Original file line numberDiff line numberDiff line change
@@ -4,13 +4,14 @@ open OUnit2
44

55
open Gcc_types
66

7+
78
let scope name var expr = Call (Fn ([name], expr), [var])
89

910

1011
let test_gcc ~ast ~path =
1112
let open Gcc_compiler in
1213
let asm = compile ast |> assemble
13-
and expected = In_channel.read_all path
14+
and expected = In_channel.read_all path |> String.rstrip
1415
in assert_equal ~printer:(sprintf "%S") expected asm
1516

1617

@@ -20,11 +21,6 @@ let test_local test_ctx =
2021
~path:"lib_test/local.gcc"
2122

2223

23-
let test_goto test_ctx =
24-
()
25-
26-
2724
let test = "GCC" >::: [
2825
"local.gcc" >:: test_local;
29-
"goto.gcc" >:: test_goto
3026
]

‎lib_test/local.gcc

+2-2
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,9 @@
33
AP 1
44
RTN
55

6-
; x
6+
; x
77
LD 0 0
8-
; x
8+
; x
99
LD 0 0
1010
ADD
1111
RTN

‎myocamlbuild.ml

+7-7
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
(* OASIS_START *)
2-
(* DO NOT EDIT (digest: fd8343ab67f6160f91dd1cd139212fcc) *)
2+
(* DO NOT EDIT (digest: eb7b55c1781ac6f4b205bd286bab5192) *)
33
module OASISGettext = struct
44
(* # 22 "src/oasis/OASISGettext.ml" *)
55

@@ -603,37 +603,37 @@ let package_default =
603603
[
604604
(OASISExpr.EBool true, S []);
605605
(OASISExpr.EFlag "strict",
606-
S [A "-w"; A "@a"; A "-warn-error"; A "-a"])
606+
S [A "-w"; A "@a-4"; A "-warn-error"; A "-a"])
607607
]);
608608
(["oasis_library_llama_man_native"; "ocaml"; "link"; "native"],
609609
[
610610
(OASISExpr.EBool true, S []);
611611
(OASISExpr.EFlag "strict",
612-
S [A "-w"; A "@a"; A "-warn-error"; A "-a"])
612+
S [A "-w"; A "@a-4"; A "-warn-error"; A "-a"])
613613
]);
614614
(["oasis_library_llama_man_byte"; "ocaml"; "ocamldep"; "byte"],
615615
[
616616
(OASISExpr.EBool true, S []);
617617
(OASISExpr.EFlag "strict",
618-
S [A "-w"; A "@a"; A "-warn-error"; A "-a"])
618+
S [A "-w"; A "@a-4"; A "-warn-error"; A "-a"])
619619
]);
620620
(["oasis_library_llama_man_native"; "ocaml"; "ocamldep"; "native"],
621621
[
622622
(OASISExpr.EBool true, S []);
623623
(OASISExpr.EFlag "strict",
624-
S [A "-w"; A "@a"; A "-warn-error"; A "-a"])
624+
S [A "-w"; A "@a-4"; A "-warn-error"; A "-a"])
625625
]);
626626
(["oasis_library_llama_man_byte"; "ocaml"; "compile"; "byte"],
627627
[
628628
(OASISExpr.EBool true, S []);
629629
(OASISExpr.EFlag "strict",
630-
S [A "-w"; A "@a"; A "-warn-error"; A "-a"])
630+
S [A "-w"; A "@a-4"; A "-warn-error"; A "-a"])
631631
]);
632632
(["oasis_library_llama_man_native"; "ocaml"; "compile"; "native"],
633633
[
634634
(OASISExpr.EBool true, S []);
635635
(OASISExpr.EFlag "strict",
636-
S [A "-w"; A "@a"; A "-warn-error"; A "-a"])
636+
S [A "-w"; A "@a-4"; A "-warn-error"; A "-a"])
637637
])
638638
];
639639
includes = [("lib_test", ["lib_src"]); ("bin_src", ["lib_src"])]

‎setup.ml

+4-4
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
(* setup.ml generated for the first time by OASIS v0.4.4 *)
22

33
(* OASIS_START *)
4-
(* DO NOT EDIT (digest: c77a54a4395ba4ba8bb9b4f87a7f95ab) *)
4+
(* DO NOT EDIT (digest: a29d5cf587e613f5e9fa02a608747fc6) *)
55
(*
66
Regenerated by OASIS v0.4.4
77
Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6734,13 +6734,13 @@ let setup_t =
67346734
[
67356735
(OASISExpr.EBool true, []);
67366736
(OASISExpr.EFlag "strict",
6737-
["-w"; "@a"; "-warn-error"; "-a"])
6737+
["-w"; "@a-4"; "-warn-error"; "-a"])
67386738
];
67396739
bs_nativeopt =
67406740
[
67416741
(OASISExpr.EBool true, []);
67426742
(OASISExpr.EFlag "strict",
6743-
["-w"; "@a"; "-warn-error"; "-a"])
6743+
["-w"; "@a-4"; "-warn-error"; "-a"])
67446744
]
67456745
},
67466746
{
@@ -6820,7 +6820,7 @@ let setup_t =
68206820
};
68216821
oasis_fn = Some "_oasis";
68226822
oasis_version = "0.4.4";
6823-
oasis_digest = Some "­¼&¥²\006òW\142\015HùC¾i{";
6823+
oasis_digest = Some "\024\145\146Nräç\001\019\000t\1582óæ\154";
68246824
oasis_exec = None;
68256825
oasis_setup_args = [];
68266826
setup_update = false

0 commit comments

Comments
 (0)