Commit 69c0c21a authored by mb0's avatar mb0
Browse files

Up.

parent b901b64c
......@@ -18,6 +18,11 @@ structure Pretty = struct
(List.map
(fn (k, i) =>
L.seq [key k, is, item i]) (rev (SymMap.listItemsi t)))
fun stringtab item t =
L.listex "{" "}" ";"
(List.map
(fn (k, i) =>
L.seq [L.str k, is, item i]) (rev (StringMap.listItemsi t)))
fun symtab {key, item} t =
L.listex "{" "}" ";"
(List.map
......@@ -26,6 +31,9 @@ structure Pretty = struct
fun symset item t =
L.listex "{" "}" ";"
(List.map item (SymSet.listItems t))
fun intset t =
L.listex "{" "}" ";"
(List.map I (IntBinarySet.listItems t))
fun symlistset item t =
L.listex "{" "}" ";"
(List.map item (SymListSet.listItems t))
......
......@@ -3,11 +3,13 @@ structure DesugarDecode = struct
structure VS = VectorSlice
structure CM = CompilationMonad
structure DT = DesugaredTree
structure Set = IntRedBlackSet
structure Set = IntBinarySet
structure Pat = DesugaredTree.Pat
open DT
val granularity: int ref = ref 8
fun insert (map, k, i) = let
val s =
case StringMap.find (map, k) of
......@@ -131,6 +133,11 @@ structure DesugarDecode = struct
(* +DEBUG:overlapping-patterns *)
(* val () = Pretty.prettyTo (TextIO.stdOut, layoutDecls decls) *)
val equiv = buildEquivClass decls
(* +DEBUG:overlapping-patterns *)
(* val () =
Pretty.prettyTo
(TextIO.stdOut,
Pretty.stringtab Pretty.intset equiv) *)
fun genBindSlices indices = let
open DT.Pat
......@@ -146,8 +153,7 @@ structure DesugarDecode = struct
let
val sz = size pat
in
(* TODO: this is granularity dependent *)
if offs = 0 andalso sz = 8
if offs = 0 andalso sz = !granularity
then
grab (ps, offs + sz,
Exp.BIND (n, returnExp tok)::acc)
......@@ -256,6 +262,9 @@ end = struct
Spec.upd
(fn (vs, ds) =>
let
val _ =
DesugarDecode.granularity :=
IntInf.toInt (Spec.get#granularity t)
val vss = desugar ds
in
vs@vss
......
......@@ -21,7 +21,7 @@ structure DesugaredTree = struct
| Pat.BND (_, str) =>
case String.fields (fn c => c = #"|") str of
p::_ => String.size p
| _ => raise Fail "pat.size.bug"
| _ => raise Fail "DesugaredTree.size.bug"
fun toWildcardPattern tokpat = let
fun lp (pats, acc) =
......
......@@ -8,17 +8,20 @@ end = struct
structure CM = CompilationMonad
structure DT = DesugaredTree
fun retokenize granularity ds = map (retok granularity) ds
fun retokenize granularity ds = List.mapPartial (retok granularity) ds
and retok granularity (ps, e) = (retokPats granularity ps, e)
and retok granularity (ps, e) =
case retokPats granularity ps of SOME ps => SOME (ps,e) | _ => NONE
and retokPats granularity pats = let
fun lp (p, len, tok, pats) =
case p of
[] =>
if len <> 0 orelse List.length tok <> 0
then raise CM.CompilationError
else rev pats
then
(print "Retokenize: SKIPPING DECODE DECLARAATION\n"
;NONE) (* TODO: emit warning! *)
else SOME (rev pats)
| p::ps =>
(case p of
[p] =>
......@@ -40,9 +43,10 @@ end = struct
Spec.upd
(fn (vs, ds) =>
(vs,
SymMap.map
(retokenize
(IntInf.toInt (Spec.get#granularity spec))) ds))
SymMap.filter (not o null)
(SymMap.map
(retokenize
(IntInf.toInt (Spec.get#granularity spec))) ds)))
spec
val pass =
......
......@@ -986,7 +986,8 @@ val / ['10010111 k k d d k k k k '] = binop SBIW rd2 ck6
### SBR
### - Set Bits in Register
val / ['0110 k k k k d d d d k k k k '] = binop SBR rd4 ck8
### => see ORI
#val / ['0110 k k k k d d d d k k k k '] = binop SBR rd4 ck8
### SBRC
### - Skip if Bit in Register is Cleared
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment