@@ -455,7 +455,6 @@ cgForeignRes (FCon (UN "JS_Unit")) x = pure x
455455cgForeignRes (FCon (UN "JS_Str")) x = pure x
456456cgForeignRes (FCon (UN "JS_Ptr")) x = pure x
457457cgForeignRes (FCon (UN "JS_Float")) x = pure x
458−--cgForeignRes _ x = x
459458cgForeignRes desc val =
460459 do
461460 st <- get
@@ -474,10 +473,13 @@ cgConst (BI i) =
474473cgConst (Ch c) = pure $ JsStr [c]
475474cgConst (Str s) = pure $ JsStr s
476475cgConst (Fl f) = pure $ JsNum f
477−cgConst (B8 x) = error "error B8"
478−cgConst (B16 x) = error "error B16"
479−cgConst (B32 x) = error "error B32"
480−cgConst (B64 x) = error "error B64"
476+cgConst (B8 x) = pure $ JsForeign (T.pack $ "new Uint8Array([" ++ show x ++ "])") []
477+cgConst (B16 x) = pure $ JsForeign (T.pack $ "new Uint16Array([" ++ show x ++ "])") []
478+cgConst (B32 x) = pure $ JsForeign (T.pack $ show x ++ "|0" ) []
479+cgConst (B64 x) =
480+ do
481+ setUsedITBig
482+ pure $ JsForeign "new jsbn.BigInteger(%0)" [JsStr $ show x]
481483cgConst x | isTypeConst x = pure $ JsInt 0
482484cgConst x = error $ "Constant " ++ show x ++ " not compilable yet"
483485
@@ -485,12 +487,28 @@ jsB2I :: JsAST -> JsAST
485487jsB2I x = JsForeign "%0 ? 1|0 : 0|0" [x]
486488
487489cgOp :: PrimFn -> [JsAST] -> State CGBodyState JsAST
490+cgOp (LAnd (ITFixed IT8)) [l, r] = pure $ JsForeign "new Uint8Array([ %0[0] & %1[0] ])" [l,r]
488491cgOp (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]
489493cgOp (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]
490497cgOp (LPlus (ATInt ITBig)) [l, r] =
491498 do
492499 setUsedITBig
493500 pure $ JsMethod l "add" [r]
501+cgOp (LPlus (ATInt (ITFixed IT64))) [l, r] =
502+ do
503+ setUsedITBig
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] =
509+ do
510+ setUsedITBig
511+ pure $ JsMethod (JsMethod l "shiftLeft" [r]) "and" [JsStr $ show 0xFFFFFFFFFFFFFFFF]
494512cgOp (LMinus ATFloat) [l, r] = pure $ JsBinOp "-" l r
495513cgOp (LMinus (ATInt ITNative)) [l, r] = pure $ JsForeign "%0-%1|0" [l,r]
496514cgOp (LMinus (ATInt ITBig)) [l, r] =
@@ -553,17 +571,39 @@ cgOp (LStrInt ITNative) [x] = pure $ JsForeign "parseInt(%0)|0" [x]
553571cgOp (LStrFloat) [x] = pure $ JsApp "parseFloat" [x]
554572cgOp (LChInt ITNative) [x] = pure $ JsForeign "%0.charCodeAt(0)|0" [x]
555573cgOp (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] =
575+ do
576+ setUsedITBig
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] =
581+ do
582+ setUsedITBig
583+ pure $ JsForeign "new Uint8Array([ %0.intValue() ])" [x]
557584cgOp (LSExt ITNative ITBig) [x] =
558585 do
559586 setUsedITBig
560587 pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
588+cgOp (LZExt (ITFixed IT8) ITNative) [x] = pure $ JsForeign "%0[0]" [x]
561589cgOp (LZExt ITNative ITBig) [x] =
562590 do
563591 setUsedITBig
564592 pure $ JsForeign "new jsbn.BigInteger(String(%0))" [x]
565−--cgOp (LZExt _ _) [x] = pure $ x
566593cgOp (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
567607cgOp (LSDiv (ATInt ITNative)) [l,r] = pure $ JsForeign "%0/%1|0" [l, r]
568608cgOp (LSDiv (ATInt ITBig)) [l,r] =
569609 do
@@ -583,5 +623,9 @@ cgOp LStrConcat [l,r] = pure $ JsBinOp "+" l r
583623cgOp LStrCons [l,r] = pure $ JsForeign "%0+%1" [l,r]
584624cgOp LStrSubstr [offset,len,str] = pure $ JsMethod str "substr" [offset, len]
585625cgOp (LSRem (ATInt ITNative)) [l,r] = pure $ JsBinOp "%" l r
626+cgOp (LSRem (ATInt ITBig)) [l,r] =
627+ do
628+ setUsedITBig
629+ pure $ JsMethod l "remainder" [r]
586630cgOp LCrash [l] = pure $ JsErrorExp l
587631cgOp op exps = error ("Operator " ++ show (op, exps) ++ " not implemented")