Permalink
Browse files

Direct support for less-than operator to get cleaner output code

  • Loading branch information...
1 parent 6bf60ee commit c991a0e68bae2e8b53c8770388a9d2c07be3e56e @batterseapower committed Jul 21, 2010
Showing with 5 additions and 4 deletions.
  1. +1 −0 Core/Parser.hs
  2. +2 −1 Core/Syntax.hs
  3. +1 −1 Evaluator/Evaluate.hs
  4. +1 −2 examples/Prelude.core
View
@@ -229,6 +229,7 @@ qNameCore (LHE.UnQual n) = fmap var $ case nameString n of
"div" -> primWrapper Divide
"mod" -> primWrapper Modulo
"==" -> primWrapper Equal
+ "<" -> primWrapper LessThan
"<=" -> primWrapper LessThanEqual
s -> return (name s)
qNameCore (LHE.Special sc) = fmap var $ dataConWrapper $ specialConDataCon sc
View
@@ -9,7 +9,7 @@ type Var = Name
type DataCon = String
-data PrimOp = Add | Subtract | Multiply | Divide | Modulo | Equal | LessThanEqual
+data PrimOp = Add | Subtract | Multiply | Divide | Modulo | Equal | LessThan | LessThanEqual
deriving (Eq, Ord, Show)
data AltCon = DataAlt DataCon [Var] | LiteralAlt Literal | DefaultAlt (Maybe Var)
@@ -71,6 +71,7 @@ instance Pretty PrimOp where
pPrint Divide = text "div"
pPrint Modulo = text "mod"
pPrint Equal = text "(==)"
+ pPrint LessThan = text "(<)"
pPrint LessThanEqual = text "(<=)"
instance Pretty AltCon where
View
@@ -52,7 +52,7 @@ primop :: Heap -> Stack -> Tag -> PrimOp -> [In TaggedValue] -> In TaggedValue -
primop h k tg pop [(_, Literal (Int l1))] (_, Literal (Int l2)) [] = (h, k, (emptyRenaming, TaggedTerm $ Tagged tg (Value (f pop l1 l2))))
where f pop = case pop of Add -> retInt (+); Subtract -> retInt (-);
Multiply -> retInt (*); Divide -> retInt div; Modulo -> retInt mod;
- Equal -> retBool (==); LessThanEqual -> retBool (<=)
+ Equal -> retBool (==); LessThan -> retBool (<); LessThanEqual -> retBool (<=)
retInt pop l1 l2 = Literal (Int (pop l1 l2))
retBool pop l1 l2 = if pop l1 l2 then Data trueDataCon [] else Data falseDataCon []
primop h k tg pop in_vs (rn, v) (in_e:in_es) = (h, Tagged tg (PrimApply pop (in_vs ++ [(rn, v)]) in_es) : k, in_e)
View
@@ -1,7 +1,6 @@
(/=) n m = not (n == m)
-(<) n m = (n <= m) && (n /= m)
(>=) n m = (<=) m n
-(>) n m = (n >= m) && (n /= m)
+(>) n m = (<) m n
negate n = 0 - n
signum n = if n < 0 then -1 else if n > 0 then 1 else 0
abs n = if n < 0 then negate n else n

0 comments on commit c991a0e

Please sign in to comment.