2013-08-31 06:18:54 +00:00
|
|
|
module Generate.JavaScript where
|
2012-04-19 06:32:10 +00:00
|
|
|
|
2013-08-31 11:01:00 +00:00
|
|
|
import Control.Arrow ((***))
|
2013-07-29 11:22:23 +00:00
|
|
|
import qualified Data.List as List
|
2012-12-26 22:07:09 +00:00
|
|
|
import qualified Data.Map as Map
|
2013-07-04 15:24:04 +00:00
|
|
|
import qualified Data.Set as Set
|
2013-08-31 11:19:18 +00:00
|
|
|
import qualified Text.Pandoc as Pan
|
2013-08-31 06:18:54 +00:00
|
|
|
|
2013-08-14 07:42:26 +00:00
|
|
|
import Generate.Cases
|
2013-08-02 23:51:29 +00:00
|
|
|
import SourceSyntax.Everything
|
2013-07-30 18:55:41 +00:00
|
|
|
import SourceSyntax.Location
|
2013-07-16 19:43:56 +00:00
|
|
|
import qualified Transform.SortDefinitions as SD
|
2013-08-31 06:18:54 +00:00
|
|
|
import Language.ECMAScript3.Syntax
|
|
|
|
import Language.ECMAScript3.PrettyPrint
|
2013-08-31 20:22:00 +00:00
|
|
|
import Parse.Helpers (jsReserveds)
|
2012-04-19 06:32:10 +00:00
|
|
|
|
2013-08-31 20:22:00 +00:00
|
|
|
makeSafe :: String -> String
|
|
|
|
makeSafe = dereserve . deprime
|
|
|
|
where
|
|
|
|
deprime = map (\c -> if c == '\'' then '$' else c)
|
|
|
|
dereserve x = case Set.member x jsReserveds of
|
|
|
|
False -> x
|
|
|
|
True -> "$" ++ x
|
2013-08-31 06:18:54 +00:00
|
|
|
|
2013-08-31 11:19:18 +00:00
|
|
|
split = go []
|
|
|
|
where
|
|
|
|
go vars str =
|
|
|
|
case break (=='.') str of
|
|
|
|
(x,'.':rest) -> go (vars ++ [x]) rest
|
|
|
|
(x,[]) -> vars ++ [x]
|
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
var name = Id () (makeSafe name)
|
|
|
|
ref name = VarRef () (var name)
|
|
|
|
prop name = PropId () (var name)
|
|
|
|
f <| x = CallExpr () f [x]
|
|
|
|
args ==> e = FuncExpr () Nothing (map var args) [ ReturnStmt () (Just e) ]
|
2013-08-31 19:14:23 +00:00
|
|
|
function args stmts = FuncExpr () Nothing (map var args) stmts
|
2013-08-31 06:18:54 +00:00
|
|
|
call = CallExpr ()
|
|
|
|
string = StringLit ()
|
|
|
|
|
|
|
|
dotSep (x:xs) = foldl (DotRef ()) (ref x) (map var xs)
|
2013-08-31 11:19:18 +00:00
|
|
|
get = dotSep . split
|
2013-08-31 06:18:54 +00:00
|
|
|
|
|
|
|
varDecl x expr =
|
|
|
|
VarDecl () (var x) (Just expr)
|
|
|
|
|
|
|
|
include alias moduleName =
|
2013-08-31 11:19:18 +00:00
|
|
|
varDecl alias (get moduleName <| ref "elm")
|
2012-10-10 21:41:40 +00:00
|
|
|
|
2013-08-04 19:51:52 +00:00
|
|
|
internalImports name =
|
2013-08-31 06:18:54 +00:00
|
|
|
VarDeclStmt ()
|
2013-08-31 11:19:18 +00:00
|
|
|
[ varDecl "N" (get "Elm.Native")
|
|
|
|
, include "_N" "N.Utils"
|
|
|
|
, include "_L" "N.List"
|
|
|
|
, include "_E" "N.Error"
|
|
|
|
, include "_J" "N.JavaScript"
|
|
|
|
, varDecl "_str" (get "_J.toString")
|
2013-08-31 06:18:54 +00:00
|
|
|
, varDecl "$moduleName" (string name)
|
2013-03-10 02:59:55 +00:00
|
|
|
]
|
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
literal lit =
|
|
|
|
case lit of
|
|
|
|
Chr c -> string [c]
|
|
|
|
Str s -> ref "_str" <| string s
|
|
|
|
IntNum n -> IntLit () n
|
2013-08-31 20:22:00 +00:00
|
|
|
FloatNum n -> NumLit () n
|
2013-08-31 06:18:54 +00:00
|
|
|
Boolean b -> BoolLit () b
|
|
|
|
|
2013-08-31 11:01:00 +00:00
|
|
|
expression :: LExpr () () -> Expression ()
|
2013-08-31 06:18:54 +00:00
|
|
|
expression (L span expr) =
|
|
|
|
case expr of
|
|
|
|
Var x -> ref x
|
|
|
|
Literal lit -> literal lit
|
2013-08-31 11:19:18 +00:00
|
|
|
Range lo hi -> get "_L.range" `call` [expression lo, expression hi]
|
2013-08-31 06:18:54 +00:00
|
|
|
|
|
|
|
Access e x -> DotRef () (expression e) (var x)
|
2013-08-31 20:22:00 +00:00
|
|
|
Remove e x -> get "_N.remove" `call` [string x, expression e]
|
|
|
|
Insert e x v -> get "_N.insert" `call` [string x, expression v, expression e]
|
2013-08-31 08:56:17 +00:00
|
|
|
Modify e fs ->
|
2013-08-31 20:22:00 +00:00
|
|
|
let modify (f,v) = ArrayLit () [string f, expression v]
|
2013-08-31 11:19:18 +00:00
|
|
|
in get "_N.replace" `call` [ArrayLit () (map modify fs), expression e]
|
2013-08-31 08:56:17 +00:00
|
|
|
|
2013-08-31 11:01:00 +00:00
|
|
|
Record fields -> ObjectLit () $ (PropId () (var "_"), hidden) : visible
|
|
|
|
where
|
|
|
|
combine r (k,v) = Map.insertWith (++) k [v] r
|
|
|
|
fieldMap = List.foldl' combine Map.empty fields
|
|
|
|
hidden = ObjectLit () . map ((PropId () . var) *** (ArrayLit () . map expression)) .
|
|
|
|
Map.toList . Map.filter (not . null) $ Map.map tail fieldMap
|
|
|
|
visible = map ((PropId () . var) *** expression) . Map.toList $ Map.map head fieldMap
|
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
Binop op e1 e2 -> binop span op e1 e2
|
|
|
|
|
|
|
|
Lambda p e@(L s _) -> fastFunc
|
|
|
|
where
|
|
|
|
fastFunc
|
|
|
|
| length args < 2 || length args > 9 =
|
|
|
|
foldr (==>) (expression body) (map (:[]) args)
|
|
|
|
| otherwise =
|
|
|
|
ref ("F" ++ show (length args)) <| (args ==> expression body)
|
|
|
|
|
2013-08-31 08:56:17 +00:00
|
|
|
(args, body) = foldr depattern ([], innerBody) (zip patterns [0..])
|
2013-08-31 06:18:54 +00:00
|
|
|
|
|
|
|
depattern (pattern,n) (args, body) =
|
|
|
|
case pattern of
|
|
|
|
PVar x -> (args ++ [x], body)
|
|
|
|
_ -> let arg = "arg" ++ show n
|
|
|
|
in (args ++ [arg], L s (Case (L s (Var arg)) [(pattern, body)]))
|
|
|
|
|
|
|
|
(patterns, innerBody) = collect [p] e
|
|
|
|
|
|
|
|
collect patterns lexpr@(L _ expr) =
|
|
|
|
case expr of
|
|
|
|
Lambda p e -> collect (p:patterns) e
|
|
|
|
_ -> (patterns, lexpr)
|
2013-08-31 08:56:17 +00:00
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
App e1 e2 ->
|
|
|
|
case args of
|
|
|
|
[arg] -> func <| arg
|
|
|
|
_ -> ref aN `call` (func:args)
|
|
|
|
where
|
|
|
|
aN = "A" ++ show (length args)
|
|
|
|
(func, args) = getArgs e1 [e2]
|
|
|
|
getArgs func args =
|
|
|
|
case func of
|
|
|
|
(L _ (App f arg)) -> getArgs f (arg : args)
|
|
|
|
_ -> (expression func, map expression args)
|
2013-08-31 08:56:17 +00:00
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
Let defs e -> function [] stmts `call` []
|
2013-08-31 08:56:17 +00:00
|
|
|
where
|
|
|
|
(defs',e') = SD.flattenLets defs e
|
2013-08-31 19:14:23 +00:00
|
|
|
stmts = concatMap definition defs' ++ [ ReturnStmt () (Just (expression e')) ]
|
2013-08-31 06:18:54 +00:00
|
|
|
|
|
|
|
MultiIf branches ->
|
|
|
|
case last branches of
|
|
|
|
(L _ (Var "otherwise"), e) -> ifs (init branches) (expression e)
|
2013-08-31 11:19:18 +00:00
|
|
|
_ -> ifs branches (get "_E.If" `call` [ ref "$moduleName", string (show span) ])
|
2013-08-31 06:18:54 +00:00
|
|
|
where
|
|
|
|
ifs branches finally = foldr iff finally branches
|
|
|
|
iff (if', then') else' = CondExpr () (expression if') (expression then') else'
|
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
Case e cases -> function [] (stmt ++ match span revisedMatch) `call` []
|
2013-08-31 11:01:00 +00:00
|
|
|
where
|
|
|
|
(tempVar,initialMatch) = caseToMatch cases
|
|
|
|
(revisedMatch, stmt) =
|
|
|
|
case e of
|
|
|
|
L _ (Var x) -> (matchSubst [(tempVar,x)] initialMatch, [])
|
2013-08-31 19:14:23 +00:00
|
|
|
_ -> (initialMatch, [VarDeclStmt () [varDecl tempVar (expression e)]])
|
2013-08-31 11:01:00 +00:00
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
ExplicitList es ->
|
2013-08-31 11:19:18 +00:00
|
|
|
get "_J.toList" <| ArrayLit () (map expression es)
|
2013-08-31 06:18:54 +00:00
|
|
|
|
|
|
|
Data name es ->
|
|
|
|
ObjectLit () (ctor : fields)
|
|
|
|
where
|
|
|
|
ctor = (prop "ctor", string (makeSafe name))
|
|
|
|
fields = zipWith (\n e -> (prop ("_" ++ show n), expression e)) [0..] es
|
2013-08-31 11:19:18 +00:00
|
|
|
|
|
|
|
Markdown doc -> get "Text.text" <| string (pad ++ md ++ pad)
|
|
|
|
where pad = "<div style=\"height:0;width:0;\"> </div>"
|
|
|
|
md = Pan.writeHtmlString Pan.def doc
|
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
|
2013-08-31 08:56:17 +00:00
|
|
|
definition def =
|
|
|
|
case def of
|
2013-08-31 19:14:23 +00:00
|
|
|
TypeAnnotation _ _ -> []
|
2013-08-31 08:56:17 +00:00
|
|
|
Def pattern expr@(L span _) ->
|
2013-08-31 19:14:23 +00:00
|
|
|
let assign x = varDecl x (expression expr) in
|
2013-08-31 08:56:17 +00:00
|
|
|
case pattern of
|
|
|
|
PVar x
|
|
|
|
| isOp x ->
|
|
|
|
let op = LBracket () (ref "_op") (string x) in
|
2013-08-31 19:14:23 +00:00
|
|
|
[ ExprStmt () (AssignExpr () OpAssign op (expression expr)) ]
|
2013-08-31 08:56:17 +00:00
|
|
|
| otherwise ->
|
2013-08-31 19:14:23 +00:00
|
|
|
[ VarDeclStmt () [ assign x ] ]
|
2013-08-31 08:56:17 +00:00
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
PRecord fields -> [ VarDeclStmt () (assign "$" : map setField fields) ]
|
2013-08-31 08:56:17 +00:00
|
|
|
where
|
2013-08-31 19:14:23 +00:00
|
|
|
setField f = varDecl f (dotSep ["$",f])
|
2013-08-31 08:56:17 +00:00
|
|
|
|
|
|
|
PData name patterns | vars /= Nothing ->
|
|
|
|
case vars of
|
2013-08-31 19:14:23 +00:00
|
|
|
Just vs -> [ VarDeclStmt () (setup (zipWith decl vs [0..])) ]
|
2013-08-31 08:56:17 +00:00
|
|
|
where
|
|
|
|
vars = getVars patterns
|
|
|
|
getVars patterns =
|
|
|
|
case patterns of
|
2013-08-31 20:22:00 +00:00
|
|
|
PVar x : rest -> (x:) `fmap` getVars rest
|
2013-08-31 08:56:17 +00:00
|
|
|
[] -> Just []
|
|
|
|
_ -> Nothing
|
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
decl x n = varDecl x (dotSep ["$","_" ++ show n])
|
2013-08-31 08:56:17 +00:00
|
|
|
setup vars
|
|
|
|
| isTuple name = assign "$" : vars
|
|
|
|
| otherwise = safeAssign : vars
|
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
safeAssign = varDecl "$" (CondExpr () if' (expression expr) exception)
|
2013-08-31 11:19:18 +00:00
|
|
|
if' = InfixExpr () OpStrictEq (get "$.ctor") (string name)
|
|
|
|
exception = get "_E.Case" `call` [ref "$moduleName", string (show span)]
|
2013-08-31 08:56:17 +00:00
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
_ -> VarDeclStmt () [assign "$"] : concatMap toDef vars
|
2013-08-31 11:01:00 +00:00
|
|
|
where
|
|
|
|
vars = Set.toList $ SD.boundVars pattern
|
|
|
|
mkVar = L span . Var
|
|
|
|
toDef y = definition $
|
2013-08-31 08:56:17 +00:00
|
|
|
Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
|
2012-04-19 06:32:10 +00:00
|
|
|
|
2013-08-31 11:01:00 +00:00
|
|
|
match span mtch =
|
|
|
|
case mtch of
|
|
|
|
Match name clauses mtch' -> SwitchStmt () (access name) clauses' : match span mtch'
|
|
|
|
where
|
|
|
|
clauses' = map (clause span name) clauses
|
|
|
|
isLiteral p = case p of
|
|
|
|
Clause (Right _) _ _ -> True
|
|
|
|
_ -> False
|
|
|
|
access name = if any isLiteral clauses then ref name else dotSep [name,"ctor"]
|
|
|
|
|
2013-08-31 11:19:18 +00:00
|
|
|
Fail -> [ ExprStmt () (get "_E.Case" `call` [ref "$moduleName", string (show span)]) ]
|
2013-08-31 11:01:00 +00:00
|
|
|
Break -> []
|
|
|
|
Other e -> [ ReturnStmt () (Just $ expression e) ]
|
|
|
|
Seq ms -> concatMap (match span) (dropEnd [] ms)
|
|
|
|
where
|
|
|
|
dropEnd acc [] = acc
|
|
|
|
dropEnd acc (m:ms) =
|
|
|
|
case m of
|
|
|
|
Other _ -> acc ++ [m]
|
|
|
|
_ -> dropEnd (acc ++ [m]) ms
|
|
|
|
|
|
|
|
clause span variable (Clause value vars mtch) =
|
|
|
|
CaseClause () pattern stmt
|
|
|
|
where
|
|
|
|
vars' = map (\n -> variable ++ "._" ++ show n) [0..]
|
|
|
|
stmt = match span $ matchSubst (zip vars vars') mtch
|
|
|
|
pattern = case value of
|
|
|
|
Right (Boolean b) -> BoolLit () b
|
|
|
|
Right lit -> literal lit
|
|
|
|
Left name -> string $ case List.elemIndices '.' name of
|
|
|
|
[] -> name
|
|
|
|
is -> drop (last is + 1) name
|
2013-08-31 19:14:23 +00:00
|
|
|
|
2013-08-31 20:22:00 +00:00
|
|
|
jsModule :: MetadataModule () () -> String -- [Statement ()]
|
|
|
|
jsModule modul = show . prettyPrint $ setup (Just "Elm") (names modul) ++
|
|
|
|
[ assign ("Elm" : names modul) (function ["elm"] programStmts) ]
|
2013-03-06 17:25:23 +00:00
|
|
|
where
|
2013-08-31 19:14:23 +00:00
|
|
|
thisModule = dotSep ("elm" : names modul)
|
|
|
|
programStmts =
|
2013-08-31 20:22:00 +00:00
|
|
|
concat [ setup (Just "elm") (names modul)
|
2013-08-31 19:14:23 +00:00
|
|
|
, [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
|
|
|
|
, [ internalImports (List.intercalate "." (names modul)) ]
|
2013-07-16 19:43:56 +00:00
|
|
|
, concatMap jsImport (imports modul)
|
2013-08-31 19:14:23 +00:00
|
|
|
, concatMap importEvent (foreignImports modul)
|
|
|
|
, [ assign ["_op"] (ObjectLit () []) ]
|
|
|
|
, concatMap definition . fst . SD.flattenLets [] $ program modul
|
|
|
|
, map exportEvent $ foreignExports modul
|
|
|
|
, [ jsExports ]
|
|
|
|
, [ ReturnStmt () (Just thisModule) ]
|
2013-07-16 19:43:56 +00:00
|
|
|
]
|
2013-02-27 07:33:47 +00:00
|
|
|
|
2013-08-31 19:14:23 +00:00
|
|
|
jsExports = assign ("elm" : names modul) (ObjectLit () exs)
|
|
|
|
where
|
|
|
|
exs = map entry . filter (not . isOp) $ "_op" : exports modul
|
|
|
|
entry x = (PropId () (var x), ref x)
|
|
|
|
|
|
|
|
assign path expr =
|
|
|
|
case path of
|
2013-08-31 20:22:00 +00:00
|
|
|
[x] -> VarDeclStmt () [ varDecl x expr ]
|
|
|
|
_ -> ExprStmt () $
|
|
|
|
AssignExpr () OpAssign (LDot () (dotSep (init path)) (last path)) expr
|
2013-08-31 19:14:23 +00:00
|
|
|
|
2013-08-31 20:22:00 +00:00
|
|
|
jsImport (modul,_) = setup Nothing path ++ [ assign path (dotSep ("Elm" : path) <| ref "elm") ]
|
2013-07-29 21:22:33 +00:00
|
|
|
where
|
2013-08-31 19:14:23 +00:00
|
|
|
path = split modul
|
2013-07-29 21:22:33 +00:00
|
|
|
|
2013-08-31 20:22:00 +00:00
|
|
|
setup namespace path = map create paths
|
2013-08-31 19:14:23 +00:00
|
|
|
where
|
|
|
|
create name = assign name (InfixExpr () OpLOr (dotSep name) (ObjectLit () []))
|
2013-08-31 20:22:00 +00:00
|
|
|
paths = case namespace of
|
|
|
|
Nothing -> tail . init $ List.inits path
|
|
|
|
Just nmspc -> drop 2 . init . List.inits $ nmspc : path
|
2013-08-31 19:14:23 +00:00
|
|
|
|
|
|
|
addId js = InfixExpr () OpAdd (string (js++"_")) (get "elm.id")
|
2013-07-29 21:22:33 +00:00
|
|
|
|
2013-07-16 19:43:56 +00:00
|
|
|
importEvent (js,base,elm,_) =
|
2013-08-31 19:14:23 +00:00
|
|
|
[ VarDeclStmt () [ varDecl elm $ get "Signal.constant" <| expression base ]
|
|
|
|
, ExprStmt () $
|
|
|
|
get "document.addEventListener" `call`
|
|
|
|
[ addId js
|
|
|
|
, function ["e"]
|
|
|
|
[ ExprStmt () $ get "elm.notify" `call` [dotSep [elm,"id"], get "e.value"] ]
|
|
|
|
]
|
|
|
|
]
|
2012-08-01 23:37:37 +00:00
|
|
|
|
2013-07-16 19:43:56 +00:00
|
|
|
exportEvent (js,elm,_) =
|
2013-08-31 19:14:23 +00:00
|
|
|
ExprStmt () $
|
|
|
|
ref "A2" `call`
|
|
|
|
[ get "Signal.lift"
|
|
|
|
, function ["v"]
|
|
|
|
[ VarDeclStmt () [varDecl "e" $ get "document.createEvent" <| string "Event"]
|
|
|
|
, ExprStmt () $
|
|
|
|
get "e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]
|
|
|
|
, ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "e") "value") (ref "v")
|
|
|
|
, ExprStmt () $ get "document.dispatchEvent" <| ref "e"
|
|
|
|
, ReturnStmt () (Just $ ref "v")
|
|
|
|
]
|
|
|
|
, ref elm ]
|
2013-08-31 11:41:36 +00:00
|
|
|
|
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
binop span op e1 e2 =
|
|
|
|
case op of
|
|
|
|
"Basics.." -> ["$"] ==> foldr (<|) (ref "$") (map expression (e1 : collect [] e2))
|
|
|
|
"Basics.<|" -> foldr (<|) (expression e2) (map expression (collect [] e1))
|
|
|
|
"::" -> expression (L span (Data "::" [e1,e2]))
|
2013-08-31 11:19:18 +00:00
|
|
|
"List.++" -> get "_L.append" `call` [js1, js2]
|
2013-08-31 06:18:54 +00:00
|
|
|
_ -> case Map.lookup op opDict of
|
|
|
|
Just f -> f js1 js2
|
2013-08-31 11:19:18 +00:00
|
|
|
Nothing -> ref "A2" `call` [ func, js1, js2 ]
|
2013-08-04 19:51:52 +00:00
|
|
|
where
|
|
|
|
collect es e =
|
|
|
|
case e of
|
|
|
|
L _ (Binop op e1 e2) | op == "Basics.." -> collect (es ++ [e1]) e2
|
|
|
|
_ -> es ++ [e]
|
|
|
|
|
2013-08-31 06:18:54 +00:00
|
|
|
js1 = expression e1
|
|
|
|
js2 = expression e2
|
|
|
|
|
2013-09-01 04:12:11 +00:00
|
|
|
func | isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)
|
2013-08-31 11:19:18 +00:00
|
|
|
| otherwise = dotSep parts
|
|
|
|
where
|
|
|
|
parts = split op
|
|
|
|
operator = last parts
|
2013-08-31 06:18:54 +00:00
|
|
|
|
|
|
|
opDict = Map.fromList (infixOps ++ specialOps)
|
|
|
|
|
2013-08-31 20:22:00 +00:00
|
|
|
specialOp str func = ("Basics." ++ str, func)
|
2013-08-31 06:18:54 +00:00
|
|
|
infixOp str op = specialOp str (InfixExpr () op)
|
|
|
|
|
|
|
|
infixOps =
|
|
|
|
[ infixOp "+" OpAdd
|
|
|
|
, infixOp "-" OpSub
|
|
|
|
, infixOp "*" OpMul
|
|
|
|
, infixOp "/" OpDiv
|
|
|
|
, infixOp "&&" OpLAnd
|
|
|
|
, infixOp "||" OpLOr
|
|
|
|
]
|
|
|
|
|
|
|
|
specialOps =
|
2013-08-31 11:19:18 +00:00
|
|
|
[ specialOp "^" $ \a b -> get "Math.pow" `call` [a,b]
|
2013-08-31 06:18:54 +00:00
|
|
|
, specialOp "|>" $ flip (<|)
|
2013-08-31 11:19:18 +00:00
|
|
|
, specialOp "==" $ \a b -> get "_N.eq" `call` [a,b]
|
|
|
|
, specialOp "/=" $ \a b -> PrefixExpr () PrefixLNot (get "_N.eq" `call` [a,b])
|
2013-08-31 06:18:54 +00:00
|
|
|
, specialOp "<" $ cmp OpLT 0
|
|
|
|
, specialOp ">" $ cmp OpGT 0
|
|
|
|
, specialOp "<=" $ cmp OpLT 1
|
|
|
|
, specialOp ">=" $ cmp OpGT (-1)
|
|
|
|
, specialOp "div" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)
|
|
|
|
]
|
|
|
|
|
2013-08-31 11:19:18 +00:00
|
|
|
cmp op n a b = InfixExpr () op (get "_N.cmp" `call` [a,b]) (IntLit () n)
|