git.iko.soy/Idris-dev
on master help sign in
More primitives; started FFI in IRTS
d4df20eEdwin Brady
iif/testvm.iif+2−1
compare with master
unifiedsplit
@@ -23,5 +23,6 @@ fun intToNat(x) = case x of {
23 | _ => S (intToNat (x - 1))
23 | _ => S (intToNat (x - 1))
24 }
24 }
25
25
26−fun main() = printNum(natToInt(plus(intToNat(fact(6)), S(S(O)))))
26+fun main() = let val = natToInt(plus(intToNat(fact(6)), S(S(O)))) in
27+ %WriteString("Answer: " ++ %IntString(val))
27
28
rts/idris_rts.c+67
@@ -57,6 +57,13 @@ VAL MKSTR(VM* vm, char* str) {
57 return cl;
57 return cl;
58}
58}
59
59
60+VAL MKPTR(VM* vm, void* ptr) {
61+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
62+ cl -> ty = PTR;
63+ cl -> info.ptr = ptr;
64+ return cl;
65+}
66+
60VAL MKCON(VM* vm, int tag, int arity, ...) {
67VAL MKCON(VM* vm, int tag, int arity, ...) {
61 Closure* cl;
68 Closure* cl;
62 int i;
69 int i;
@@ -109,6 +116,66 @@ void dumpVal(VAL v) {
109
116
110}
117}
111
118
119+VAL idris_castIntStr(VM* vm, VAL i) {
120+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*));
121+ cl -> ty = STRING;
122+ cl -> info.str = allocate(vm, sizeof(char)*16);
123+ sprintf(cl -> info.str, "%ld", GETINT(i));
124+ return cl;
125+}
126+
127+VAL idris_castStrInt(VM* vm, VAL i) {
128+ char *end;
129+ i_int v = strtol(GETSTR(i), &end, 10);
130+ if (*end != '\0') return MKINT(0); else return MKINT(v);
131+}
132+
133+VAL idris_castFloatStr(VM* vm, VAL i) {
134+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*));
135+ cl -> ty = STRING;
136+ cl -> info.str = allocate(vm, sizeof(char)*32);
137+ sprintf(cl -> info.str, "%g", GETFLOAT(i));
138+ return cl;
139+}
140+
141+VAL idris_castStrFloat(VM* vm, VAL i) {
142+ return MKFLOAT(vm, strtod(GETSTR(i), NULL));
143+}
144+
145+VAL idris_concat(VM* vm, VAL l, VAL r) {
146+ char *ls = GETSTR(l);
147+ char *rs = GETSTR(r);
148+
149+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*));
150+ cl -> ty = STRING;
151+ cl -> info.str = allocate(vm, sizeof(char)*(strlen(ls)+strlen(rs)+1));
152+ strcpy(cl -> info.str, ls);
153+ strcat(cl -> info.str, rs);
154+ return cl;
155+}
156+
157+VAL idris_strlt(VM* vm, VAL l, VAL r) {
158+ char *ls = GETSTR(l);
159+ char *rs = GETSTR(r);
160+
161+ return MKINT((i_int)(strcmp(ls, rs) < 0));
162+}
163+
164+VAL idris_streq(VM* vm, VAL l, VAL r) {
165+ char *ls = GETSTR(l);
166+ char *rs = GETSTR(r);
167+
168+ return MKINT((i_int)(strcmp(ls, rs) == 0));
169+}
170+
171+VAL idris_strlen(VM* vm, VAL l) {
172+ return MKINT((i_int)(strlen(GETSTR(l))));
173+}
174+
175+VAL idris_readStr(VM* vm, FILE* h) {
176+}
177+
178+
112void stackOverflow() {
179void stackOverflow() {
113 fprintf(stderr, "Stack overflow");
180 fprintf(stderr, "Stack overflow");
114 exit(-1);
181 exit(-1);
rts/idris_rts.h+21−2
@@ -61,8 +61,8 @@ typedef void(*func)(VM*, VAL*);
61// Retrieving values
61// Retrieving values
62
62
63#define GETSTR(x) (((VAL)(x))->info.str)
63#define GETSTR(x) (((VAL)(x))->info.str)
64−#define GETPTR(x) (((void*)(x))->info.ptr)
64+#define GETPTR(x) (((VAL)(x))->info.ptr)
65−#define GETFLOAT(x) (((double)(x))->info.f)
65+#define GETFLOAT(x) (((VAL)(x))->info.f)
66
66
67#define TAG(x) ((x)->info.c.tag)
67#define TAG(x) ((x)->info.c.tag)
68
68
@@ -96,6 +96,7 @@ typedef intptr_t i_int;
96// Creating new values (each value placed at the top of the stack)
96// Creating new values (each value placed at the top of the stack)
97VAL MKFLOAT(VM* vm, double val);
97VAL MKFLOAT(VM* vm, double val);
98VAL MKSTR(VM* vm, char* str);
98VAL MKSTR(VM* vm, char* str);
99+VAL MKPTR(VM* vm, void* ptr);
99
100
100VAL MKCON(VM* vm, int tag, int arity, ...);
101VAL MKCON(VM* vm, int tag, int arity, ...);
101
102
@@ -104,6 +105,24 @@ void SLIDE(VM* vm, int args);
104
105
105void dumpVal(VAL r);
106void dumpVal(VAL r);
106
107
108+// Casts
109+
110+#define idris_castIntFloat(x) MKFLOAT(vm, (double)(GETINT(x)))
111+#define idris_castFloatInt(x) MKINT((i_int)(GETFLOAT(x)))
112+
113+VAL idris_castIntStr(VM* vm, VAL i);
114+VAL idris_castStrInt(VM* vm, VAL i);
115+VAL idris_castFloatStr(VM* vm, VAL i);
116+VAL idris_castStrFloat(VM* vm, VAL i);
117+
118+// String primitives
119+
120+VAL idris_concat(VM* vm, VAL l, VAL r);
121+VAL idris_strlt(VM* vm, VAL l, VAL r);
122+VAL idris_streq(VM* vm, VAL l, VAL r);
123+VAL idris_strlen(VM* vm, VAL l);
124+VAL idris_readStr(VM* vm, FILE* h);
125+
107// Handle stack overflow.
126// Handle stack overflow.
108// Just reports an error and exits.
127// Just reports an error and exits.
109
128
src/IRTS/Bytecode.hs+4
@@ -30,6 +30,7 @@ data BC = ASSIGN Reg Reg
30 | CONSTCASE Reg [(Const, [BC])] (Maybe [BC])
30 | CONSTCASE Reg [(Const, [BC])] (Maybe [BC])
31 | CALL Name
31 | CALL Name
32 | TAILCALL Name
32 | TAILCALL Name
33+ | FOREIGNCALL Reg FLang FType String [(FType, Reg)]
33 | SLIDE Int -- move this number from TOP to BASE
34 | SLIDE Int -- move this number from TOP to BASE
34 | REBASE -- set BASE = OLDBASE
35 | REBASE -- set BASE = OLDBASE
35 | RESERVE Int -- reserve n more stack items
36 | RESERVE Int -- reserve n more stack items
@@ -61,6 +62,9 @@ bc reg (SApp False f vs) r
61bc reg (SApp True f vs) r
62bc reg (SApp True f vs) r
62 = RESERVE (length vs) : moveReg 0 vs
63 = RESERVE (length vs) : moveReg 0 vs
63 ++ [SLIDE (length vs), TOPBASE (length vs), TAILCALL f]
64 ++ [SLIDE (length vs), TOPBASE (length vs), TAILCALL f]
65+bc reg (SForeign l t fname args) r
66+ = FOREIGNCALL reg l t fname (map farg args) : clean r
67+ where farg (ty, Loc i) = (ty, L i)
64bc reg (SLet (Loc i) e sc) r = bc (L i) e False ++ bc reg sc r
68bc reg (SLet (Loc i) e sc) r = bc (L i) e False ++ bc reg sc r
65bc reg (SCon i _ vs) r = MKCON reg i (map getL vs) : clean r
69bc reg (SCon i _ vs) r = MKCON reg i (map getL vs) : clean r
66 where getL (Loc x) = L x
70 where getL (Loc x) = L x
src/IRTS/CodegenC.hs+43−1
@@ -79,12 +79,54 @@ bcc i STOREOLD = indent i ++ "STOREOLD;\n"
79bcc i (OP l fn args) = indent i ++ creg l ++ " = " ++ doOp fn args ++ ";\n"
79bcc i (OP l fn args) = indent i ++ creg l ++ " = " ++ doOp fn args ++ ";\n"
80-- bcc i _ = indent i ++ "// not done yet\n"
80-- bcc i _ = indent i ++ "// not done yet\n"
81
81
82+c_irts FInt x = "MKINT((i_int)(" ++ x ++ ")"
83+c_irts FString x = "MKSTR(" ++ x ++ ")"
84+c_irts FUnit x = "MKINT(42424242)"
85+c_irts FPtr x = "MKPTR(" ++ x ++ ")"
86+c_irts FDouble x = "MKFLOAT(vm, " ++ x ++ ")"
87+c_irts FAny x = x
88+
89+irts_c FInt x = "GETINT(" ++ x ++ ")"
90+irts_c FString x = "GETSTR(" ++ x ++ ")"
91+irts_c FUnit x = x
92+irts_c FPtr x = "GETPTR(" ++ x ++ ")"
93+irts_c FDouble x = "GETFLOAT(" ++ x ++ ")"
94+irts_c FAny x = x
95+
82doOp LPlus [l, r] = "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
96doOp LPlus [l, r] = "ADD(" ++ creg l ++ ", " ++ creg r ++ ")"
83doOp LMinus [l, r] = "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
97doOp LMinus [l, r] = "INTOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
84doOp LTimes [l, r] = "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
98doOp LTimes [l, r] = "MULT(" ++ creg l ++ ", " ++ creg r ++ ")"
85doOp LDiv [l, r] = "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
99doOp LDiv [l, r] = "INTOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
86doOp LEq [l, r] = "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
100doOp LEq [l, r] = "INTOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
101+doOp LLt [l, r] = "INTOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
102+doOp LLe [l, r] = "INTOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
103+doOp LGt [l, r] = "INTOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
104+doOp LGe [l, r] = "INTOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
105+
106+doOp LFPlus [l, r] = "FLOATOP(+" ++ creg l ++ ", " ++ creg r ++ ")"
107+doOp LFMinus [l, r] = "FLOATOP(-," ++ creg l ++ ", " ++ creg r ++ ")"
108+doOp LFTimes [l, r] = "FLOATOP(*" ++ creg l ++ ", " ++ creg r ++ ")"
109+doOp LFDiv [l, r] = "FLOATOP(/," ++ creg l ++ ", " ++ creg r ++ ")"
110+doOp LFEq [l, r] = "FLOATBOP(==," ++ creg l ++ ", " ++ creg r ++ ")"
111+doOp LFLt [l, r] = "FLOATBOP(<," ++ creg l ++ ", " ++ creg r ++ ")"
112+doOp LFLe [l, r] = "FLOATBOP(<=," ++ creg l ++ ", " ++ creg r ++ ")"
113+doOp LFGt [l, r] = "FLOATBOP(>," ++ creg l ++ ", " ++ creg r ++ ")"
114+doOp LFGe [l, r] = "FLOATBOP(>=," ++ creg l ++ ", " ++ creg r ++ ")"
115+
116+doOp LStrConcat [l,r] = "idris_concat(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
117+doOp LStrLt [l,r] = "idris_strlt(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
118+doOp LStrEq [l,r] = "idris_streq(vm, " ++ creg l ++ ", " ++ creg r ++ ")"
119+doOp LStrLen [x] = "idris_strlen(vm, " ++ creg x ++ ")"
120+
121+doOp LIntFloat [x] = "idris_castIntFloat(" ++ creg x ++ ")"
122+doOp LFloatInt [x] = "idris_castFloatInt(" ++ creg x ++ ")"
123+doOp LIntStr [x] = "idris_castIntStr(vm, " ++ creg x ++ ")"
124+doOp LStrInt [x] = "idris_castFloatStr(vm, " ++ creg x ++ ")"
125+doOp LFloatStr [x] = "idris_castFloatStr(vm, " ++ creg x ++ ")"
126+doOp LStrFloat [x] = "idris_castStrFloat(vm, " ++ creg x ++ ")"
127+
128+doOp LReadStr [] = "idris_readStr(vm, stdin)"
87doOp LPrintNum [x] = "NULL; printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"
129doOp LPrintNum [x] = "NULL; printf(\"%ld\\n\", GETINT(" ++ creg x ++ "))"
88−doOp LPrintStr [x] = "NULL; printf(GETSTR(" ++ creg x ++ "))"
130+doOp LPrintStr [x] = "NULL; puts(GETSTR(" ++ creg x ++ "))"
89doOp _ _ = "FAIL"
131doOp _ _ = "FAIL"
90
132
src/IRTS/LParser.hs+57−8
@@ -62,6 +62,7 @@ fovm f = do defs <- parseFOVM f
62 d <- getDataDir
62 d <- getDataDir
63 mprog <- readFile (d ++ "/rts/idris_main.c")
63 mprog <- readFile (d ++ "/rts/idris_main.c")
64 putStrLn mprog
64 putStrLn mprog
65+ err -> print err
65
66
66parseFOVM :: FilePath -> IO [(Name, LDecl)]
67parseFOVM :: FilePath -> IO [(Name, LDecl)]
67parseFOVM fname = do -- putStrLn $ "Reading " ++ fname
68parseFOVM fname = do -- putStrLn $ "Reading " ++ fname
@@ -92,18 +93,35 @@ pLDecl = do reserved "data"
92pLExp = buildExpressionParser optable pLExp'
93pLExp = buildExpressionParser optable pLExp'
93
94
94optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
95optable = [[binary "*" (\x y -> LOp LTimes [x,y]) AssocLeft,
95− binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft],
96+ binary "/" (\x y -> LOp LDiv [x,y]) AssocLeft,
97+ binary "*." (\x y -> LOp LFTimes [x,y]) AssocLeft,
98+ binary "/." (\x y -> LOp LFTimes [x,y]) AssocLeft
99+ ],
100+ [
96− [binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,
101+ binary "+" (\x y -> LOp LPlus [x,y]) AssocLeft,
97− binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft],
102+ binary "-" (\x y -> LOp LMinus [x,y]) AssocLeft,
103+ binary "++" (\x y -> LOp LStrConcat [x,y]) AssocLeft,
104+ binary "+." (\x y -> LOp LFPlus [x,y]) AssocLeft,
105+ binary "-." (\x y -> LOp LFMinus [x,y]) AssocLeft
106+ ],
107+ [
98− [binary "==" (\x y -> LOp LEq [x, y]) AssocNone]]
108+ binary "==" (\x y -> LOp LEq [x, y]) AssocNone,
109+ binary "==." (\x y -> LOp LFEq [x, y]) AssocNone,
110+ binary "<" (\x y -> LOp LLt [x, y]) AssocNone,
111+ binary "<." (\x y -> LOp LFLt [x, y]) AssocNone,
112+ binary ">" (\x y -> LOp LGt [x, y]) AssocNone,
113+ binary ">." (\x y -> LOp LFGt [x, y]) AssocNone,
114+ binary "<=" (\x y -> LOp LLe [x, y]) AssocNone,
115+ binary "<=." (\x y -> LOp LFLe [x, y]) AssocNone,
116+ binary ">=" (\x y -> LOp LGe [x, y]) AssocNone,
117+ binary ">=." (\x y -> LOp LFGe [x, y]) AssocNone
118+ ]]
99
119
100binary name f assoc = Infix (do reservedOp name; return f) assoc
120binary name f assoc = Infix (do reservedOp name; return f) assoc
101
121
102pLExp' :: LParser LExp
122pLExp' :: LParser LExp
103−pLExp' = try (do reserved "printNum"; e <- pLExp
123+pLExp' = try (do lchar '%'; pCast)
104− return (LOp LPrintNum [e]))
124+ <|> try (do lchar '%'; pPrim)
105− <|> try (do reserved "print"; e <- pLExp
106− return (LOp LPrintStr [e]))
107 <|> try (do tc <- option False (do lchar '%'; reserved "tc"; return True)
125 <|> try (do tc <- option False (do lchar '%'; reserved "tc"; return True)
108 x <- iName [];
126 x <- iName [];
109 lchar '('
127 lchar '('
@@ -115,10 +133,25 @@ pLExp' = try (do reserved "printNum"; e <- pLExp
115 <|> do reserved "let"; x <- iName []; lchar '='; v <- pLExp
133 <|> do reserved "let"; x <- iName []; lchar '='; v <- pLExp
116 reserved "in"; e <- pLExp
134 reserved "in"; e <- pLExp
117 return (LLet x v e)
135 return (LLet x v e)
136+ <|> do reserved "foreign"; l <- pLang; t <- pType
137+ fname <- strlit
138+ lchar '('
139+ fargs <- sepBy (do t' <- pType; e <- pLExp; return (t', e)) (lchar ',')
140+ lchar ')'
141+ return (LForeign l t fname fargs)
118 <|> pCase
142 <|> pCase
119 <|> do x <- iName []
143 <|> do x <- iName []
120 return (LV (Glob x))
144 return (LV (Glob x))
121
145
146+pLang = do reserved "C"; return LANG_C
147+
148+pType = do reserved "Int"; return FInt
149+ <|> do reserved "Float"; return FDouble
150+ <|> do reserved "String"; return FString
151+ <|> do reserved "Unit"; return FUnit
152+ <|> do reserved "Ptr"; return FPtr
153+ <|> do reserved "Any"; return FAny
154+
122pCase :: LParser LExp
155pCase :: LParser LExp
123pCase = do reserved "case"; e <- pLExp; reserved "of"
156pCase = do reserved "case"; e <- pLExp; reserved "of"
124 lchar '{'
157 lchar '{'
@@ -126,6 +159,22 @@ pCase = do reserved "case"; e <- pLExp; reserved "of"
126 lchar '}'
159 lchar '}'
127 return (LCase e alts)
160 return (LCase e alts)
128
161
162+pCast :: LParser LExp
163+pCast = do reserved "FloatString"; e <- pLExp; return (LOp LFloatStr [e])
164+ <|> do reserved "StringFloat"; e <- pLExp; return (LOp LStrFloat [e])
165+ <|> do reserved "FloatInt"; e <- pLExp; return (LOp LFloatInt [e])
166+ <|> do reserved "IntFloat"; e <- pLExp; return (LOp LIntFloat [e])
167+ <|> do reserved "StringInt"; e <- pLExp; return (LOp LStrInt [e])
168+ <|> do reserved "IntString"; e <- pLExp; return (LOp LIntStr [e])
169+
170+pPrim :: LParser LExp
171+pPrim = do reserved "StrEq"; e <- pLExp; e' <- pLExp; return (LOp LStrEq [e, e'])
172+ <|> do reserved "StrLt"; e <- pLExp; e' <- pLExp; return (LOp LStrLt [e, e'])
173+ <|> do reserved "StrLen"; e <- pLExp; return (LOp LStrLen [e])
174+ <|> do reserved "ReadString"; return (LOp LReadStr [])
175+ <|> do reserved "WriteString"; e <- pLExp; return (LOp LPrintStr [e])
176+ <|> do reserved "WriteInt"; e <- pLExp; return (LOp LPrintNum [e])
177+
129pAlt :: LParser LAlt
178pAlt :: LParser LAlt
130pAlt = try (do x <- iName []
179pAlt = try (do x <- iName []
131 lchar '('; args <- sepBy1 (iName []) (lchar ','); lchar ')'
180 lchar '('; args <- sepBy1 (iName []) (lchar ','); lchar ')'
src/IRTS/Lang.hs+14−2
@@ -11,11 +11,23 @@ data LExp = LV LVar
11 | LCon Int Name [LExp]
11 | LCon Int Name [LExp]
12 | LCase LExp [LAlt]
12 | LCase LExp [LAlt]
13 | LConst Const
13 | LConst Const
14+ | LForeign FLang FType String [(FType, LExp)]
14 | LOp PrimFn [LExp]
15 | LOp PrimFn [LExp]
15 deriving Show
16 deriving Show
16
17
17−data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq
18+data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
19+ | LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
20+ | LStrConcat | LStrLt | LStrEq | LStrLen
21+ | LIntFloat | LFloatInt | LIntStr | LStrInt | LFloatStr | LStrFloat
18− | LPrintNum | LPrintStr
22+ | LPrintNum | LPrintStr | LReadStr
23+ deriving Show
24+
25+-- Supported target languages for foreign calls
26+
27+data FLang = LANG_C
28+ deriving Show
29+
30+data FType = FInt | FString | FUnit | FPtr | FDouble | FAny
19 deriving Show
31 deriving Show
20
32
21data LAlt = LConCase Int Name [Name] LExp
33data LAlt = LConCase Int Name [Name] LExp
src/IRTS/Simplified.hs+12
@@ -14,6 +14,7 @@ data SExp = SV LVar
14 | SCon Int Name [LVar]
14 | SCon Int Name [LVar]
15 | SCase LVar [SAlt]
15 | SCase LVar [SAlt]
16 | SConst Const
16 | SConst Const
17+ | SForeign FLang FType String [(FType, LVar)]
17 | SOp PrimFn [LVar]
18 | SOp PrimFn [LVar]
18 deriving Show
19 deriving Show
19
20
@@ -43,6 +44,10 @@ simplify tl (LV (Glob x))
43 _ -> return $ SV (Glob x)
44 _ -> return $ SV (Glob x)
44simplify tl (LApp tc n args) = do args' <- mapM sVar args
45simplify tl (LApp tc n args) = do args' <- mapM sVar args
45 mkapp (SApp (tl || tc) n) args'
46 mkapp (SApp (tl || tc) n) args'
47+simplify tl (LForeign lang ty fn args)
48+ = do args' <- mapM sVar (map snd args)
49+ let fargs = zip (map fst args) args'
50+ mkfapp (SForeign lang ty fn) fargs
46simplify tl (LLet n v e) = do v' <- simplify False v
51simplify tl (LLet n v e) = do v' <- simplify False v
47 e' <- simplify tl e
52 e' <- simplify tl e
48 return (SLet (Glob n) v' e')
53 return (SLet (Glob n) v' e')
@@ -75,6 +80,13 @@ mkapp f args = mkapp' f args [] where
75 = do sc <- mkapp' f xs (x : args)
80 = do sc <- mkapp' f xs (x : args)
76 return (SLet x e sc)
81 return (SLet x e sc)
77
82
83+mkfapp f args = mkapp' f args [] where
84+ mkapp' f [] args = return $ f (reverse args)
85+ mkapp' f ((ty, (x, Nothing)) : xs) args = mkapp' f xs ((ty, x) : args)
86+ mkapp' f ((ty, (x, Just e)) : xs) args
87+ = do sc <- mkapp' f xs ((ty, x) : args)
88+ return (SLet x e sc)
89+
78sAlt tl (LConCase i n args e) = do e' <- simplify tl e
90sAlt tl (LConCase i n args e) = do e' <- simplify tl e
79 return (SConCase (-1) i n args e')
91 return (SConCase (-1) i n args e')
80sAlt tl (LConstCase c e) = do e' <- simplify tl e
92sAlt tl (LConstCase c e) = do e' <- simplify tl e