app/Gyehoek/ANF.hs

@@ -31,14 +31,15 @@ import Gyehoek.QBE (FuncDef(FuncDef))
 import Data.Foldable1
 import qualified Data.Text as T
 import Data.String (fromString)
-import Language.SexpGrammar as Sexp hiding (List)
+import Language.SexpGrammar as Sexp hiding (List, iso)
 import Language.SexpGrammar.Generic
-import GHC.Generics
+import GHC.Generics (Generic)
 import Control.Category
 import Prelude hiding ((.), id)
 import Data.InvertibleGrammar.Base qualified as IG
 import Data.InvertibleGrammar.Base ((:-)((:-)))
 import qualified Gyehoek.Sexp
+import Control.Lens.Unsound
 
 
 data Val
@@ -48,6 +49,7 @@ data Val
 
 data Exp
   = ExpLetApply Name Val (List Val) Exp
+  | ExpLetPrim Name (Prim Val) Exp
   | ExpBegin (List Exp)
   | ExpVal Val
   deriving (Show, Generic)
@@ -66,33 +68,56 @@ collapseBindings p l e =
     Just a -> collapseBindings p l (a ^. l) & _1 %~ (a:)
     Nothing -> ([], e)
 
+foldLet
+  :: Prism' Exp a
+  -> Lens' a lhs
+  -> Lens' a rhs
+  -> Lens' a Exp
+  -> Grammar
+       Position
+       (Exp :- NonEmpty (lhs, rhs) :- t)
+       (Exp :- _)
+foldLet p lhs rhs exp =
+  IG.Iso
+    _
+    _
+
 instance SexpIso Val where
   sexpIso = match
     $ With (. sexpIso)
     $ With (. symbol)
     $ End
 
+nonEmptyIso :: Iso (NonEmpty a) (NonEmpty b) (a, List a) (b, List b)
+nonEmptyIso = iso (\(x:|xs) -> (x,xs)) (uncurry (:|))
+
 instance SexpIso Exp where
   sexpIso = match
     $ With (. letapp)
+    $ With (. letprim)
     $ With (\bgn -> bgn . list (el (sym "begin") >>> rest sexpIso))
     $ With (. sexpIso)
     $ End
     where
+      letprim
+        :: Grammar Position (Sexp :- t) (Exp :- (Prim Val :- (Text :- t)))
+      letprim =
+        Gyehoek.Sexp.let_ symbol (sexpIso @(Prim Val)) (sexpIso @Exp)
+        >>> foldLet #ExpLetPrim _1 _2 _3
       letapp :: Grammar
         Position (Sexp :- t) (Exp :- List Val :- Val :- Text :- t)
       letapp =
         Gyehoek.Sexp.let_ symbol (sexpIso @(NonEmpty Val)) (sexpIso @Exp)
-         >>> foldLet
+         >>> foldLet #ExpLetApply _1 (lensProduct _2 _3 . from nonEmptyIso) _4
-      foldLet =
+      -- foldLet =
-        IG.Iso
+      --   IG.Iso
-          (\(e :- ((r,f:|xs):|bs) :- t) ->
+      --     (\(e :- ((r,f:|xs):|bs) :- t) ->
-             foldr (\(v,g:|ys) -> ExpLetApply v g ys) e bs
+      --        foldr (\(v,g:|ys) -> ExpLetApply v g ys) e bs
-               :- xs :- f :- r :- t)
+      --          :- xs :- f :- r :- t)
-          (\(e :- xs :- f :- r :- t) ->
+      --     (\(e :- xs :- f :- r :- t) ->
-             let (bs,e') = collapseBindings #ExpLetApply _4 e
+      --        let (bs,e') = collapseBindings #ExpLetApply _4 e
-                           & _1 . each %~ \(x,g,ys,_) -> (x,g:|ys)
+      --                      & _1 . each %~ \(x,g,ys,_) -> (x,g:|ys)
-             in e' :- ((r,f:|xs):|bs) :- t)
+      --        in e' :- ((r,f:|xs):|bs) :- t)
 
 
 
@@ -188,13 +213,6 @@ buildBlock n bb = QBE.Block n [] (is ^.. each) j
 lowerName :: Name -> QBE.Ident t
 lowerName = fromString . T.unpack
 
-lowerPrim :: Prim -> _ -> _
-lowerPrim PrimAdd k = k $ QBE.ValGlobal "plus"
-lowerPrim PrimMul k = k $ QBE.ValGlobal "star"
-lowerPrim PrimSub k = k $ QBE.ValGlobal "_"
-lowerPrim PrimDiv k = k $ QBE.ValGlobal "slash"
-lowerPrim p k = _
-
 lowerVal
   :: forall es. (GenSym :> es)
   => Val

app/Gyehoek/Syntax.hs

@@ -17,8 +17,12 @@ import Gyehoek.Sexp qualified
 
 type Name = Text
 
-data Prim = PrimAdd | PrimSub | PrimMul | PrimDiv
+data Prim e
-  deriving (Show, Generic)
+  = PrimAdd e e
+  | PrimSub e e
+  | PrimMul e e
+  | PrimDiv e e
+  deriving (Show, Generic, Functor, Foldable, Traversable)
 
 data Lit
   = LitInt Int
@@ -31,20 +35,22 @@ data Exp
   | ExpApply Exp (List Exp)
   | ExpBegin (List Exp)
   | ExpLit Lit
-  | ExpPrim Prim
+  | ExpPrim (Prim Exp)
   | ExpLambda (List Name) Exp
   | ExpVar Name
   deriving (Show, Generic)
 
 
 
-instance SexpIso Prim where
+instance SexpIso a => SexpIso (Prim a) where
   sexpIso = match
-    $ With (. sym "+")
+    $ With (. binop "prim-+")
-    $ With (. sym "-")
+    $ With (. binop "prim--")
-    $ With (. sym "*")
+    $ With (. binop "prim-*")
-    $ With (. sym "/")
+    $ With (. binop "prim-/")
     $ End
+    where
+      binop s = list $ el (sym s) >>> el sexpIso >>> el sexpIso
 
 instance SexpIso Lit where
   sexpIso = match
@@ -52,7 +58,6 @@ instance SexpIso Lit where
     $ With (. sym "nil")
     $ With (. sexpIso)
     $ End
-    where
 
 instance SexpIso Exp where
   sexpIso = match

flake.nix

@@ -71,6 +71,7 @@
       packages = each-system ({ pkgs, system, ... }:
         hf.packages.${system} // {
           default = hf.packages.${system}."gyehoek:exe:gyehoek";
+          runtime = pkgs.callPackage ./runtime {};
         });
 
       devShells = each-system

runtime/Makefile

@@ -0,0 +1,8 @@
+all: gyehoek.o
+
+gyehoek.o: gyehoek.c
+	$(CC) $(CFLAGS) -c gyehoek.c -o gyehoek.o
+
+.PHONY: install
+install:
+	install -Dm644 -t $(out)/lib gyehoek.o

runtime/default.nix

@@ -0,0 +1,10 @@
+{ stdenv
+, callPackage
+, bdwgc ? callPackage ./bdwgc.nix {}
+}:
+
+stdenv.mkDerivation {
+  pname = "gyehoek";
+  version = "1.0.0";
+  src = ./.;
+}

runtime/gyehoek.c

@@ -0,0 +1,5 @@
+#include <stdio.h>
+
+int blah () {
+  puts ("aaa");
+}