Commit 6f563dc5 authored by Axel Simon's avatar Axel Simon
Browse files

fix complex patterns and improve error message

parent 37a1e9d1
...@@ -11,8 +11,9 @@ end = struct ...@@ -11,8 +11,9 @@ end = struct
open CM open CM
infix >>= infix >>=
infix >>
fun all s = fun all s =
SplitDeclarations.run s >>= SplitDeclarations.run s >>=
DesugarGuards.run >>= DesugarGuards.run >>=
InlineDecodePatterns.run >>= InlineDecodePatterns.run >>=
...@@ -24,6 +25,8 @@ end = struct ...@@ -24,6 +25,8 @@ end = struct
fun dumpPre (os, (_, spec)) = AT.PP.prettyTo (os, spec) fun dumpPre (os, (_, spec)) = AT.PP.prettyTo (os, spec)
fun dumpPost (os, spec) = Pretty.prettyTo (os, Core.PP.spec spec) fun dumpPost (os, spec) = Pretty.prettyTo (os, Core.PP.spec spec)
fun pass (s, spec) = CM.run s (all spec) fun pass (s, spec) = CM.run s (all spec)
handle DT.DesugarTreeException (sp,err) =>
CM.run s (errorAt (sp, [err]) >> fail)
val desugar = val desugar =
BasicControl.mkKeepPass BasicControl.mkKeepPass
......
structure DesugaredTree = struct structure DesugaredTree = struct
exception DesugarTreeException of (Error.span * string)
structure Exp = Core.Exp structure Exp = Core.Exp
type sym = Core.sym type sym = Core.sym
...@@ -82,28 +84,30 @@ structure DesugaredTree = struct ...@@ -82,28 +84,30 @@ structure DesugaredTree = struct
mapUpdates fs mapUpdates fs
end end
and match (p, e) = (pat p, exp e) and match (p, e) = (pat SymbolTable.noSpan p, exp e)
and stripMarkPat p = and stripMarkPat sp p =
case p of case p of
MARKpat t => stripMarkPat (#tree t) MARKpat t => stripMarkPat (#span t) (#tree t)
| p => p | p => (sp,p)
and pat p = and pat sp p =
case p of case p of
MARKpat t => pat (#tree t) MARKpat t => pat (#span t) (#tree t)
| CONpat (s, SOME p) => | CONpat (s, SOME p) =>
let let
val p = stripMarkPat p val (sp,p) = stripMarkPat sp p
in in
case p of case p of
IDpat x => Pat.CON (s, SOME x) IDpat x => Pat.CON (s, SOME x)
| _ => raise Fail "Invalid pattern (too complex...)" | _ => raise DesugarException
(sp, "expect variable as argument in constructor pattern")
end end
| CONpat (s, NONE) => Pat.CON (s, NONE) | CONpat (s, NONE) => Pat.CON (s, NONE)
| LITpat (INTlit i) => Pat.INT i | LITpat (INTlit i) => Pat.INT i
| LITpat (VEClit i) => Pat.BIT i | LITpat (VEClit i) => Pat.BIT i
| LITpat _ => raise CM.CompilationError | LITpat _ => raise DesugarException
(sp, "cannot pattern match against this literal")
| IDpat id => Pat.ID id | IDpat id => Pat.ID id
| WILDpat => Pat.WILD | WILDpat => Pat.WILD
......
...@@ -1882,14 +1882,19 @@ val segmentation-set-for-base base = ...@@ -1882,14 +1882,19 @@ val segmentation-set-for-base base =
in in
do do
mode64 <- mode64?; mode64 <- mode64?;
if not(mode64) then if not(mode64) then return void else
case base of case base of
REG ESP: override-ss REG r: case r of
| REG EBP: override-ss SP : override-ss
| _: return void | ESP: override-ss
end | RSP: override-ss
else | BP : override-ss
return void | EBP: override-ss
| RBP: override-ss
| _ : return void
end
| _ : return void
end
end end
end end
......
Markdown is supported
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