@@ -455,7 +455,6 @@ cgForeignRes (FCon (UN "JS_Unit")) x = pure x
455cgForeignRes (FCon (UN "JS_Str")) x = pure x
455cgForeignRes (FCon (UN "JS_Str")) x = pure x
456cgForeignRes (FCon (UN "JS_Ptr")) x = pure x
456cgForeignRes (FCon (UN "JS_Ptr")) x = pure x
457cgForeignRes (FCon (UN "JS_Float")) x = pure x
457cgForeignRes (FCon (UN "JS_Float")) x = pure x
458−--cgForeignRes _ x = x
459cgForeignRes desc val =
458cgForeignRes desc val =
461 st <- get
460 st <- get
@@ -474,10 +473,13 @@ cgConst (BI i) =
474cgConst (Ch c) = pure $ JsStr [c]
473cgConst (Ch c) = pure $ JsStr [c]
475cgConst (Str s) = pure $ JsStr s
474cgConst (Str s) = pure $ JsStr s
476cgConst (Fl f) = pure $ JsNum f
475cgConst (Fl f) = pure $ JsNum f
477−cgConst (B8 x) = error "error B8"
476+cgConst (B8 x) = pure $ JsForeign (T.pack $ "new Uint8Array([" ++ show x ++ "])") []
478−cgConst (B16 x) = error "error B16"
477+cgConst (B16 x) = pure $ JsForeign (T.pack $ "new Uint16Array([" ++ show x ++ "])") []
479−cgConst (B32 x) = error "error B32"
478+cgConst (B32 x) = pure $ JsForeign (T.pack $ show x ++ "|0" ) []
480−cgConst (B64 x) = error "error B64"
479+cgConst (B64 x) =
482+ pure $ JsForeign "new jsbn.BigInteger(%0)" [JsStr $ show x]
481cgConst x | isTypeConst x = pure $ JsInt 0
483cgConst x | isTypeConst x = pure $ JsInt 0
482cgConst x = error $ "Constant " ++ show x ++ " not compilable yet"
484cgConst x = error $ "Constant " ++ show x ++ " not compilable yet"
@@ -485,12 +487,28 @@ jsB2I :: JsAST -> JsAST
485jsB2I x = JsForeign "%0 ? 1|0 : 0|0" [x]
487jsB2I x = JsForeign "%0 ? 1|0 : 0|0" [x]
487cgOp :: PrimFn -> [JsAST] -> State CGBodyState JsAST
489cgOp :: PrimFn -> [JsAST] -> State CGBodyState JsAST
490+cgOp (LAnd (ITFixed IT8)) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] & %1[0] ])" [l,r]
488cgOp (LPlus ATFloat) [l, r] = pure $ JsBinOp "+" l r
491cgOp (LPlus ATFloat) [l, r] = pure $ JsBinOp "+" l r
492+cgOp (LPlus (ATInt ITChar)) [l, r] = pure $ JsForeign "String.fromCharCode(%0.charCodeAt(0) + %1.charCodeAt(0))" [l,r]
489cgOp (LPlus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
493cgOp (LPlus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
494+cgOp (LPlus (ATInt (ITFixed IT8))) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] + %1[0] ])" [l,r]
495+cgOp (LPlus (ATInt (ITFixed IT16))) [l, r] = pure $ JsForeign "new Uint16Array([ %0[0] + %1[0] ])" [l,r]
496+cgOp (LPlus (ATInt (ITFixed IT32))) [l, r] = pure $ JsForeign "%0+%1|0" [l,r]
490cgOp (LPlus (ATInt ITBig)) [l, r] =
497cgOp (LPlus (ATInt ITBig)) [l, r] =
492 setUsedITBig
499 setUsedITBig
493 pure $ JsMethod l "add" [r]
500 pure $ JsMethod l "add" [r]
501+cgOp (LPlus (ATInt (ITFixed IT64))) [l, r] =
504+ pure $ JsMethod (JsMethod l "add" [r]) "and" [JsStr $ show 0xFFFFFFFFFFFFFFFF]
505+cgOp (LLSHR (ITFixed IT8)) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] >> %1[0] ])" [l,r]
506+cgOp (LLSHR (ITFixed IT16)) [l, r] = pure $ JsForeign "new Uint16Array([ %0[0] >> %1[0] ])" [l,r]
507+cgOp (LLSHR (ITFixed IT32)) [l, r] = pure $ JsForeign "%0 >> %1|0" [l,r]
508+cgOp (LLSHR (ITFixed IT64)) [l, r] =
511+ pure $ JsMethod (JsMethod l "shiftLeft" [r]) "and" [JsStr $ show 0xFFFFFFFFFFFFFFFF]
494cgOp (LMinus ATFloat) [l, r] = pure $ JsBinOp "-" l r
512cgOp (LMinus ATFloat) [l, r] = pure $ JsBinOp "-" l r
495cgOp (LMinus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0-%1|0" [l,r]
513cgOp (LMinus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0-%1|0" [l,r]
496cgOp (LMinus (ATInt ITBig)) [l, r] =
514cgOp (LMinus (ATInt ITBig)) [l, r] =
@@ -553,17 +571,39 @@ cgOp (LStrInt ITNative) [x] = pure $ JsForeign "parseInt(%0)|0" [x]
553cgOp (LStrFloat) [x] = pure $ JsApp "parseFloat" [x]
571cgOp (LStrFloat) [x] = pure $ JsApp "parseFloat" [x]
554cgOp (LChInt ITNative) [x] = pure $ JsForeign "%0.charCodeAt(0)|0" [x]
572cgOp (LChInt ITNative) [x] = pure $ JsForeign "%0.charCodeAt(0)|0" [x]
555cgOp (LIntCh ITNative) [x] = pure $ JsApp "String.fromCharCode" [x]
573cgOp (LIntCh ITNative) [x] = pure $ JsApp "String.fromCharCode" [x]
556−cgOp (LTrunc ITBig ITNative) [x] = pure $ JsForeign "%0.intValue()|0" [x]
574+cgOp (LTrunc ITBig ITNative) [x] =
577+ pure $ JsForeign "%0.intValue()|0" [x]
578+cgOp (LTrunc (ITFixed IT16) (ITFixed IT8)) [x] = pure $ JsForeign "new Uint8Array([ %0[0] ])" [x]
579+cgOp (LTrunc (ITFixed IT32) (ITFixed IT8)) [x] = pure $ JsForeign "new Uint8Array([ %0 ])" [x]
580+cgOp (LTrunc (ITFixed IT64) (ITFixed IT8)) [x] =
583+ pure $ JsForeign "new Uint8Array([ %0.intValue() ])" [x]
557cgOp (LSExt ITNative ITBig) [x] =
584cgOp (LSExt ITNative ITBig) [x] =
559 setUsedITBig
586 setUsedITBig
560 pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
587 pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
588+cgOp (LZExt (ITFixed IT8) ITNative) [x] = pure $ JsForeign "%0[0]" [x]
561cgOp (LZExt ITNative ITBig) [x] =
589cgOp (LZExt ITNative ITBig) [x] =
563 setUsedITBig
591 setUsedITBig
564 pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
592 pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
565−--cgOp (LZExt _ _) [x] = pure $ x
566cgOp (LIntFloat ITNative) [x] = pure $ x
593cgOp (LIntFloat ITNative) [x] = pure $ x
594+cgOp LFACos [x] = pure $ JsApp "Math.acos" [x]
595+cgOp LFATan [x] = pure $ JsApp "Math.atan" [x]
596+cgOp LFCos [x] = pure $ JsApp "Math.cos" [x]
597+cgOp LFFloor [x] = pure $ JsApp "Math.floor" [x]
598+cgOp LFSin [x] = pure $ JsApp "Math.sin" [x]
599+cgOp LFTan [x] = pure $ JsApp "Math.tan" [x]
600+cgOp LFASin [x] = pure $ JsApp "Math.asin" [x]
601+cgOp LFCeil [x] = pure $ JsApp "Math.ceil" [x]
602+cgOp LFExp [x] = pure $ JsApp "Math.exp" [x]
603+cgOp LFLog [x] = pure $ JsApp "Math.log" [x]
604+cgOp LFSqrt [x] = pure $ JsApp "Math.sqrt" [x]
605+cgOp LFNegate [x] = pure $ JsForeign "-%0" [x]
606+cgOp (LSDiv ATFloat) [l,r] = pure $ JsBinOp "/" l r
567cgOp (LSDiv (ATInt ITNative)) [l,r] = pure $ JsForeign "%0/%1|0" [l, r]
607cgOp (LSDiv (ATInt ITNative)) [l,r] = pure $ JsForeign "%0/%1|0" [l, r]
568cgOp (LSDiv (ATInt ITBig)) [l,r] =
608cgOp (LSDiv (ATInt ITBig)) [l,r] =
@@ -583,5 +623,9 @@ cgOp LStrConcat [l,r] = pure $ JsBinOp "+" l r
583cgOp LStrCons [l,r] = pure $ JsForeign "%0+%1" [l,r]
623cgOp LStrCons [l,r] = pure $ JsForeign "%0+%1" [l,r]
584cgOp LStrSubstr [offset,len,str] = pure $ JsMethod str "substr" [offset, len]
624cgOp LStrSubstr [offset,len,str] = pure $ JsMethod str "substr" [offset, len]
585cgOp (LSRem (ATInt ITNative)) [l,r] = pure $ JsBinOp "%" l r
625cgOp (LSRem (ATInt ITNative)) [l,r] = pure $ JsBinOp "%" l r
626+cgOp (LSRem (ATInt ITBig)) [l,r] =
629+ pure $ JsMethod l "remainder" [r]
586cgOp LCrash [l] = pure $ JsErrorExp l
630cgOp LCrash [l] = pure $ JsErrorExp l
587cgOp op exps = error ("Operator " ++ show (op, exps) ++ " not implemented")
631cgOp op exps = error ("Operator " ++ show (op, exps) ++ " not implemented")