interned symbols

app/Gyehoek/ANF/Syntax.hs

@@ -276,17 +276,10 @@ lowerInt = QBE.ValConst . QBE.CInt
   . (Data.Bits..<<. 2)
   . fromIntegral
 
-lowerVal
+lowerString
   :: forall es. (GenSym :> es, Writer (Vector QBE.DataDef) :> es)
-  => Val
-  -> (QBE.Val -> Eff es BlockBuilder)
-  -> Eff es BlockBuilder
-
-lowerVal (ValLit (LitInt n)) k = k . lowerInt $ n
-
--- lowerVal (ValLit (LitQuote (SexpSymbol s))) k = _aaa
-
-lowerVal (ValLit (LitString s)) k = do
+  => Text -> (QBE.Val -> Eff es BlockBuilder) -> Eff es BlockBuilder
+lowerString s k = do
   rawString <- gensym
   r <- gensym
   let bs = T.encodeUtf8 s
@@ -309,6 +302,31 @@ lowerVal (ValLit (LitString s)) k = do
         []
       ]
 
+lowerVal
+  :: forall es. (GenSym :> es, Writer (Vector QBE.DataDef) :> es)
+  => Val
+  -> (QBE.Val -> Eff es BlockBuilder)
+  -> Eff es BlockBuilder
+
+lowerVal (ValLit (LitInt n)) k = k . lowerInt $ n
+
+lowerVal (ValLit (LitQuote (Lam.SexpSymbol s))) k =
+  lowerString s \s' -> do
+    r <- gensym
+    Emit (intern r s') <$> k (QBE.ValTemporary r)
+  where
+    intern r s' =
+      [ QBE.Call
+        (Just (r, QBE.AbiBaseTy QBE.Long))
+        (QBE.ValGlobal "scm_string_to_symbol")
+        Nothing
+        [ QBE.Arg (QBE.AbiBaseTy QBE.Long) s'
+        ]
+        []
+      ]
+
+lowerVal (ValLit (LitString s)) k = lowerString s k
+
 lowerVal (ValLit _) k = error "todo"
 lowerVal (ValVar x) k = k . QBE.ValTemporary . lowerName $ x
 
@@ -445,6 +463,14 @@ lowerCdr r x e k = do
        ]
     <$> lower' e k
 
+lowerNewline r k =
+  Emit [ QBE.Call (Just (lowerName r, QBE.AbiBaseTy QBE.Long))
+         (QBE.ValGlobal "scm_newline") Nothing
+         []
+         []
+       ]
+    <$> k (QBE.ValTemporary (lowerName r))
+
 lowerPrim 
   :: forall es. (GenSym :> es, Writer (Vector QBE.DataDef) :> es)
   => Name -> Prim Val -> Exp
@@ -462,6 +488,7 @@ lowerPrim r p e k =
     PrimCar x -> lowerCar r x e k
     PrimCdr x -> lowerCdr r x e k
     PrimWrite x -> lowerWrite r x e k
+    PrimNewline -> lowerNewline r k
 
 lower'
   :: forall es. (GenSym :> es, Writer (Vector QBE.DataDef) :> es)

app/Gyehoek/Scheme/Syntax.hs

@@ -40,6 +40,7 @@ data Prim e
   | PrimConsP e
   | PrimIntegerP e
   | PrimWrite e
+  | PrimNewline
   deriving (Show, Generic, Functor, Foldable, Traversable)
 
 instance Each (Prim e) (Prim e') e e'
@@ -90,9 +91,11 @@ instance SexpIso a => SexpIso (Prim a) where
     $ With (. unop "cons?")
     $ With (. unop "integer?")
     $ With (. unop "write")
+    $ With (. nullop "newline")
     $ End
     where
       primname = ("prim:" <>)
+      nullop s = list $ el (sym (primname s))
       unop s = list $ el (sym (primname s)) >>> el sexpIso
       binop s = list $ el (sym (primname s)) >>> el sexpIso >>> el sexpIso