提交: de203222d444a26d5f4b5ea9b4b6884ba50cb824 - cammy (git)

A categorical programming language

Commit MetaInfo

• 修訂: de203222d444a26d5f4b5ea9b4b6884ba50cb824 (tree)
• 時間: 2022-11-28 07:34:34
• 作者: Corbin <cds@corb...>
• Commiter: Corbin

Log Message

Finish switching over to PureScript.

This is very messy and I'm not really pleased with it. The overall
speedup that I was hoping for? Not there!

Change Summary

• modified: honey/cammy.purs
• modified: honey/honey.py
• modified: honey/static/Cammy/foreign.js

差異

--- a/honey/cammy.purs
+++ b/honey/cammy.purs
@@ -24,7 +24,7 @@ bind f (Pure x) = f x
 bind f (Free thunk) = Free (\u -> bind f (thunk u))
 
 join :: forall t. Tramp (Tramp t) -> Tramp t
-join = bind id
+join = bind (\x -> x)
 
 -- This function will be called to evaluate "toplevel" expressions
 runTrampoline :: forall t. Tramp t -> t
@@ -34,6 +34,9 @@ runTrampoline (Free thunk) = runTrampoline (thunk Unit)
 lift :: forall s t. (s -> t) -> s -> Tramp t
 lift f x = Pure (f x)
 
+lift2 :: forall s t u. (s -> t -> u) -> Pair s t -> Tramp u
+lift2 f (Pair x y) = Pure (f x y)
+
 -- Cammy core types
 data Pair s t = Pair s t
 data Either s t = Left s | Right t
@@ -43,33 +46,33 @@ makePair = Pair
 
 -- Cammy core primitives
 
-id :: forall t. t -> t
-id x = x
+id :: forall t. t -> Tramp t
+id = done
 
-ignore :: forall t. t -> Unit
-ignore _ = Unit
+ignore :: forall t. t -> Tramp Unit
+ignore _ = done Unit
 
-fst :: forall s t. Pair s t -> s
-fst (Pair x _) = x
+fst :: forall s t. Pair s t -> Tramp s
+fst (Pair x _) = done x
 
-snd :: forall s t. Pair s t -> t
-snd (Pair _ y) = y
+snd :: forall s t. Pair s t -> Tramp t
+snd (Pair _ y) = done y
 
-dup :: forall t. t -> Pair t t
-dup x = Pair x x
+dup :: forall t. t -> Tramp (Pair t t)
+dup x = done (Pair x x)
 
 app :: forall s t. Pair (s -> Tramp t) s -> Tramp t
 app (Pair f x) = f x
 
-left :: forall s t. s -> Either s t
-left = Left
+left :: forall s t. s -> Tramp (Either s t)
+left = lift Left
 
-right :: forall s t. t -> Either s t
-right = Right
+right :: forall s t. t -> Tramp (Either s t)
+right = lift Right
 
-either :: Boolean -> Either Unit Unit
-either true = Left Unit
-either false = Right Unit
+either :: Boolean -> Tramp (Either Unit Unit)
+either true = done (Left Unit)
+either false = done (Right Unit)
 
 foreign import natAdd :: Int -> Int -> Int
 foreign import natIsZero :: Int -> Boolean
@@ -127,8 +130,11 @@ conj :: Pair Boolean Boolean -> Tramp Boolean
 conj (Pair true true) = done true
 conj _ = done false
 
--- fixNaN x = if isNaN x then right (ignore Unit) else left x
--- rescueNaN f x = fixNaN (f x)
+foreign import butIsNaN :: Number -> Boolean
+
+fixNaN :: Number -> Tramp (Either Number Unit)
+fixNaN x = if butIsNaN x then right Unit else left x
+rescueNaN f x = fixNaN (f x)
 
 foreign import natZero :: Unit -> Int
 foreign import natSucc :: Int -> Int
@@ -152,3 +158,43 @@ foreign import listCons :: forall t. t -> Array t -> Array t
 
 cons :: forall t. Pair t (Array t) -> Tramp (Array t)
 cons (Pair x xs) = done (listCons x xs)
+
+foreign import fZero :: Unit -> Number
+foreign import fOne :: Unit -> Number
+foreign import fPi :: Unit -> Number
+foreign import fAdd :: Number -> Number -> Number
+foreign import fMul :: Number -> Number -> Number
+foreign import fLT :: Number -> Number -> Boolean
+foreign import fCos :: Number -> Number
+foreign import fSin :: Number -> Number
+foreign import fNegate :: Number -> Number
+
+f'zero :: Unit -> Tramp Number
+f'zero = lift fZero
+
+f'one :: Unit -> Tramp Number
+f'one = lift fOne
+
+f'pi :: Unit -> Tramp Number
+f'pi = lift fPi
+
+f'add (Pair x y) = done (fAdd x y)
+f'mul (Pair x y) = done (fMul x y)
+f'lt (Pair x y) = done (fLT x y)
+f'cos = lift fCos
+f'sin = lift fSin
+
+f'negate = lift fNegate
+
+foreign import fATan2 :: Number -> Number -> Number
+foreign import fRecip :: Number -> Number
+foreign import fSign :: Number -> Boolean
+foreign import fFloor :: Number -> Number
+foreign import fSqrt :: Number -> Number
+
+f'atan2 = lift2 fATan2
+f'recip = lift fRecip
+f'sign = lift fSign
+
+f'floor x = done (rescueNaN fFloor x)
+f'sqrt x = done (rescueNaN fSqrt x)

--- a/honey/honey.py
+++ b/honey/honey.py
@@ -132,7 +132,9 @@ def compilePurescriptStub(token):
             handle.write(PURS_STUB)
             handle.write("\nmain = ")
             # purs can't handle hyphens in function names!
-            handle.write(sexpify(expr).replace("-", "'"))
+            # Also `case` is reserved.
+            sexp = sexpify(expr).replace("-", "'").replace("case", "caseOf")
+            handle.write(sexp)
             handle.write("\n\n")
         subprocess.check_output([PURESCRIPT + "purs", "compile", "-o", "/tmp/", "/tmp/cammy.purs"])
         with open("/tmp/Cammy/index.js") as handle:

--- a/honey/static/Cammy/foreign.js
+++ b/honey/static/Cammy/foreign.js
@@ -1,20 +1,22 @@
 export const natZero = _ => 0;
 export const natSucc = n => n + 1;
 
-// "f-zero": _ => 0.0,
-// "f-one": _ => 1.0,
-// "f-pi": _ => Math.PI,
-// "f-add": xy => Cammy.fst(xy) + Cammy.snd(xy),
-// "f-mul": xy => Cammy.fst(xy) * Cammy.snd(xy),
-// "f-negate": x => -x,
-// "f-recip": x => 1 / x,
-// "f-sign": x => x <= -0.0,
-// "f-floor": rescueNaN(Math.floor),
-// "f-sqrt": rescueNaN(Math.sqrt),
-// "f-lt": xy => Cammy.fst(xy) < Cammy.snd(xy),
-// "f-sin": x => Number.isFinite(x) ? Math.sin(x) : 0.0,
-// "f-cos": x => Number.isFinite(x) ? Math.cos(x) : 0.0,
-// "f-atan2": yx => Math.atan2(Cammy.fst(yx), Cammy.snd(yx)),
+export const fZero = _ => 0.0;
+export const fOne = _ => 1.0;
+export const fPi = _ => Math.PI;
+export const fAdd = x => y => x + y;
+export const fMul = x => y => x * y;
+export const fLT = x => y => x < y;
+export const fSin = x => Number.isFinite(x) ? Math.sin(x) : 0.0;
+export const fCos = x => Number.isFinite(x) ? Math.cos(x) : 0.0;
+export const fATan2 = y => x => Math.atan2(y, x);
+export const fNegate = x => -x;
+export const fRecip = x => 1 / x;
+export const fSign = x => x <= -0.0;
+
+export const butIsNaN = x => isNaN(x);
+export const fFloor = Math.floor;
+export const fSqrt = Math.sqrt;
 
 export const intSub = x => y => x - y;