더 간단한 신택스 annotations

2026-09-25 14:54:50 -06:00
parent 38b4047f5d
commit 7bc5f25984
31 changed files with 229 additions and 324 deletions
@@ -1,4 +1,4 @@
 [0;31m([0m[0;95;1;3mbegin[0m
-  [0m책을[0m
-  [0m더[0m
-  [0m먹으세요~![0m[0;31m)[0m
+  책을
+  더
+  먹으세요~![0;31m)[0m
@@ -1,4 +1,4 @@
 [0;31m([0m[0;95;1;3mbegin[0m
-  [0m책을[0m
-  [0m더[0m
-  [0m먹으세요~![0m[0;31m)[0m
+  책을
+  더
+  먹으세요~![0;31m)[0m
@@ -1,5 +1,5 @@
 [0;31m([0m[0;95;1;3mlambda[0m
-    [0;33m([0m[0m어간[0m
-     [0m어미[0m[0;33m)[0m
-  [0;33m([0m[0mdisplay[0m
-   [0m꾸깃[0m[0;33m)[0m[0;31m)[0m
+    [0;33m([0m어간
+     어미[0;33m)[0m
+  [0;33m([0mdisplay
+   꾸깃[0;33m)[0m[0;31m)[0m
@@ -1,2 +1,2 @@
-[0;31m([0m[0;95;1;3mlambda[0m [0;33m([0m[0m어간[0m [0m어미[0m[0;33m)[0m
-  [0;33m([0m[0mdisplay[0m [0m꾸깃[0m[0;33m)[0m[0;31m)[0m
+[0;31m([0m[0;95;1;3mlambda[0m [0;33m([0m어간 어미[0;33m)[0m
+  [0;33m([0mdisplay 꾸깃[0;33m)[0m[0;31m)[0m
@@ -1,4 +1,4 @@
-[0;31m([0m[0m가[0m
- [0m나[0m
- [0m다[0m
- [0m라[0m[0;31m)[0m
+[0;31m([0m가
+ 나
+ 다
+ 라[0;31m)[0m
@@ -1 +1 @@
-[0;31m([0m[0m가[0m [0m나[0m [0m다[0m [0m라[0m[0;31m)[0m
+[0;31m([0m가 나 다 라[0;31m)[0m
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/bool/source.scm"
            , sourceLine = Pos 1
@@ -9,8 +8,7 @@
        )
    } :< SimpleF ( SimpleBoolean True )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/bool/source.scm"
            , sourceLine = Pos 1
@@ -19,8 +17,7 @@
        )
    } :< SimpleF ( SimpleBoolean True )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/bool/source.scm"
            , sourceLine = Pos 1
@@ -29,8 +26,7 @@
        )
    } :< SimpleF ( SimpleBoolean False )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/bool/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/decimal/source.scm"
            , sourceLine = Pos 1
@@ -10,8 +9,7 @@
    } :< SimpleF
    ( SimpleNumber 45.0 )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/decimal/source.scm"
            , sourceLine = Pos 1
@@ -21,8 +19,7 @@
    } :< SimpleF
    ( SimpleNumber 5667.0 )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/decimal/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/list-dot-flat/source.scm"
            , sourceLine = Pos 1
@@ -11,8 +10,7 @@
    ( DotListF
        (
            ( MkAnn
-                { syntax = SynNone
-                , position = Just
+                { position = Just
                    ( SourcePos
                        { sourceName = "golden/read/list-dot-flat/source.scm"
                        , sourceLine = Pos 1
@@ -23,8 +21,7 @@
                ( SimpleSymbol "가" )
            ) :|
            [ MkAnn
-                { syntax = SynNone
-                , position = Just
+                { position = Just
                    ( SourcePos
                        { sourceName = "golden/read/list-dot-flat/source.scm"
                        , sourceLine = Pos 1
@@ -34,8 +31,7 @@
                } :< SimpleF
                ( SimpleSymbol "나" )
            , MkAnn
-                { syntax = SynNone
-                , position = Just
+                { position = Just
                    ( SourcePos
                        { sourceName = "golden/read/list-dot-flat/source.scm"
                        , sourceLine = Pos 1
@@ -47,8 +43,7 @@
            ]
        )
        ( MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-dot-flat/source.scm"
                    , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/list-flat/source.scm"
            , sourceLine = Pos 1
@@ -8,10 +7,9 @@
            }
        )
    } :< CompoundF
-    ( ListF Ordinary
+    ( ListF StyleData
        [ MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -21,8 +19,7 @@
            } :< SimpleF
            ( SimpleSymbol "가" )
        , MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -32,8 +29,7 @@
            } :< SimpleF
            ( SimpleSymbol "나" )
        , MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -43,8 +39,7 @@
            } :< SimpleF
            ( SimpleSymbol "다" )
        , MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -54,8 +49,7 @@
            } :< SimpleF
            ( SimpleSymbol "라" )
        , MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -65,8 +59,7 @@
            } :< SimpleF
            ( SimpleNumber 1.0 )
        , MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -76,8 +69,7 @@
            } :< SimpleF
            ( SimpleNumber 2.0 )
        , MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list-flat/source.scm"
                    , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/list/source.scm"
            , sourceLine = Pos 1
@@ -11,8 +10,7 @@
    ( DotListF
        (
            ( MkAnn
-                { syntax = SynNone
-                , position = Just
+                { position = Just
                    ( SourcePos
                        { sourceName = "golden/read/list/source.scm"
                        , sourceLine = Pos 1
@@ -23,8 +21,7 @@
                ( SimpleSymbol "a" )
            ) :|
            [ MkAnn
-                { syntax = SynNone
-                , position = Just
+                { position = Just
                    ( SourcePos
                        { sourceName = "golden/read/list/source.scm"
                        , sourceLine = Pos 1
@@ -34,8 +31,7 @@
                } :< SimpleF
                ( SimpleSymbol "b" )
            , MkAnn
-                { syntax = SynNone
-                , position = Just
+                { position = Just
                    ( SourcePos
                        { sourceName = "golden/read/list/source.scm"
                        , sourceLine = Pos 1
@@ -43,10 +39,9 @@
                        }
                    )
                } :< CompoundF
-                ( ListF Ordinary
+                ( ListF StyleData
                    [ MkAnn
-                        { syntax = SynNone
-                        , position = Just
+                        { position = Just
                            ( SourcePos
                                { sourceName = "golden/read/list/source.scm"
                                , sourceLine = Pos 1
@@ -56,8 +51,7 @@
                        } :< SimpleF
                        ( SimpleSymbol "c" )
                    , MkAnn
-                        { syntax = SynNone
-                        , position = Just
+                        { position = Just
                            ( SourcePos
                                { sourceName = "golden/read/list/source.scm"
                                , sourceLine = Pos 1
@@ -71,8 +65,7 @@
            ]
        )
        ( MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/list/source.scm"
                    , sourceLine = Pos 1
@@ -80,10 +73,9 @@
                    }
                )
            } :< CompoundF
-            ( ListF Ordinary
+            ( ListF StyleData
                [ MkAnn
-                    { syntax = SynNone
-                    , position = Just
+                    { position = Just
                        ( SourcePos
                            { sourceName = "golden/read/list/source.scm"
                            , sourceLine = Pos 1
@@ -93,8 +85,7 @@
                    } :< SimpleF
                    ( SimpleSymbol "가" )
                , MkAnn
-                    { syntax = SynNone
-                    , position = Just
+                    { position = Just
                        ( SourcePos
                            { sourceName = "golden/read/list/source.scm"
                            , sourceLine = Pos 1
@@ -105,8 +96,7 @@
                    ( DotListF
                        (
                            ( MkAnn
-                                { syntax = SynNone
-                                , position = Just
+                                { position = Just
                                    ( SourcePos
                                        { sourceName = "golden/read/list/source.scm"
                                        , sourceLine = Pos 1
@@ -118,8 +108,7 @@
                            ) :| []
                        )
                        ( MkAnn
-                            { syntax = SynNone
-                            , position = Just
+                            { position = Just
                                ( SourcePos
                                    { sourceName = "golden/read/list/source.scm"
                                    , sourceLine = Pos 1
@@ -131,8 +120,7 @@
                        )
                    )
                , MkAnn
-                    { syntax = SynNone
-                    , position = Just
+                    { position = Just
                        ( SourcePos
                            { sourceName = "golden/read/list/source.scm"
                            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/meta-expression/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/meta-splice-expression/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/meta-splice-variable/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/meta-variable/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-dot/source.scm"
            , sourceLine = Pos 1
@@ -10,8 +9,7 @@
    } :< SimpleF
    ( SimpleSymbol "..." )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-dot/source.scm"
            , sourceLine = Pos 2
@@ -21,8 +19,7 @@
    } :< SimpleF
    ( SimpleSymbol ".." )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-dot/source.scm"
            , sourceLine = Pos 3
@@ -32,8 +29,7 @@
    } :< SimpleF
    ( SimpleSymbol ".abc" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-dot/source.scm"
            , sourceLine = Pos 4
@@ -43,8 +39,7 @@
    } :< SimpleF
    ( SimpleSymbol "....abcc" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-dot/source.scm"
            , sourceLine = Pos 5
@@ -54,8 +49,7 @@
    } :< SimpleF
    ( SimpleSymbol ".++-" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-dot/source.scm"
            , sourceLine = Pos 6
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 1
@@ -10,8 +9,7 @@
    } :< SimpleF
    ( SimpleSymbol "+" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 1
@@ -21,8 +19,7 @@
    } :< SimpleF
    ( SimpleSymbol "-" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 3
@@ -32,8 +29,7 @@
    } :< SimpleF
    ( SimpleSymbol "+." )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 3
@@ -43,8 +39,7 @@
    } :< SimpleF
    ( SimpleSymbol "+.." )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 3
@@ -54,8 +49,7 @@
    } :< SimpleF
    ( SimpleSymbol "-." )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 3
@@ -65,8 +59,7 @@
    } :< SimpleF
    ( SimpleSymbol "-...abc" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/peculiar-identifier-sign/source.scm"
            , sourceLine = Pos 3
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/string/source.scm"
            , sourceLine = Pos 1
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier-token/source.scm"
            , sourceLine = Pos 1
@@ -10,8 +9,7 @@
    } :< SimpleF
    ( SimpleSymbol "abc" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier-token/source.scm"
            , sourceLine = Pos 1
@@ -21,8 +19,7 @@
    } :< SimpleF
    ( SimpleString "xyz" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier-token/source.scm"
            , sourceLine = Pos 2
@@ -32,8 +29,7 @@
    } :< SimpleF
    ( SimpleSymbol "수학" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier-token/source.scm"
            , sourceLine = Pos 2
@@ -41,10 +37,9 @@
            }
        )
    } :< CompoundF
-    ( ListF Ordinary
+    ( ListF StyleData
        [ MkAnn
-            { syntax = SynNone
-            , position = Just
+            { position = Just
                ( SourcePos
                    { sourceName = "golden/read/typical-identifier-token/source.scm"
                    , sourceLine = Pos 2
@@ -1,6 +1,5 @@
 [ MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -10,8 +9,7 @@
    } :< SimpleF
    ( SimpleSymbol "abc" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -21,8 +19,7 @@
    } :< SimpleF
    ( SimpleSymbol "bala-hwa$" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -32,8 +29,7 @@
    } :< SimpleF
    ( SimpleSymbol "x!!!" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -43,8 +39,7 @@
    } :< SimpleF
    ( SimpleSymbol "z" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -54,8 +49,7 @@
    } :< SimpleF
    ( SimpleSymbol "z123" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -65,8 +59,7 @@
    } :< SimpleF
    ( SimpleSymbol "나는너무졸리다" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 1
@@ -76,8 +69,7 @@
    } :< SimpleF
    ( SimpleSymbol "學" )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 3
@@ -87,8 +79,7 @@
    } :< SimpleF
    ( SimpleSymbol "車室." )
 , MkAnn
-    { syntax = SynNone
-    , position = Just
+    { position = Just
        ( SourcePos
            { sourceName = "golden/read/typical-identifier/source.scm"
            , sourceLine = Pos 5
@@ -26,6 +26,7 @@ common ghcstuffs
  ghc-options:
    -Wall -fdefer-type-errors -fno-show-valid-hole-fits
    -fdefer-out-of-scope-variables -threaded
+    -Wno-name-shadowing -Wno-partial-type-signatures

  default-extensions:
    BlockArguments
@@ -54,6 +55,7 @@ executable gyehoek
 library
  import:           ghcstuffs, ghcstuffs-dev
  ghc-options:      -fplugin=Effectful.Plugin
+  -- build-tool-depends: retrie:retrie

  -- cabal-fmt: expand src
  exposed-modules:
@@ -5,6 +5,8 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{- HLINT ignore "Avoid lambda using `infix`" -}
+{- HLINT ignore "Redundant $" -}
 module Gyehoek.CPS.Syntax
  ( Val(..)
  , Kappa(..)
@@ -59,15 +61,12 @@ import Data.Monoid (Endo)
 import Data.Functor.Foldable.TH
 import Data.Data.Lens (uniplate)
 import Gyehoek.Prelude hiding (op)
-import Gyehoek.Sexp (Datum)
-import Gyehoek.Sexp (G, (:-)(..))
+import Gyehoek.Sexp (G, (:-)(..), Datum)
 import qualified Data.InvertibleGrammar.Base as IG
 import Gyehoek.GenSym (Gen)
 import Data.String (IsString)
 import Control.Applicative
 import qualified Data.HashMap.Strict as H
-import GHC.Records (HasField (..))
-import Data.Bifunctor

 -- Data types

@@ -103,6 +102,7 @@ data Obj
  deriving stock (Show, Generic, Data, Eq)
  deriving anyclass (NFData)

+pattern ObjLabel :: Label -> Obj
 pattern ObjLabel l = ObjImm (ImmLabel l)

 -- | a heap object.
@@ -188,7 +188,7 @@ pattern Halt1 x = ExpContinue (ValLabel "halt") [x]
 data Def = DefConstant Name Exp
  deriving (Show, Generic, Data)

-data Program = MkProgram
+newtype Program = MkProgram
  { body :: Lambda
  }
  deriving (Show, Generic, Data)
@@ -272,7 +272,7 @@ instance S.DatumIso Imm where

 instance S.DatumIso Label where
  datumIso = S.with \g -> S.coproduct
-    [ S.decorate S.SynConstant >>> S.datumIso @Name >>> S.prismIso
+    [ S.datumIso @Name >>> S.prismIso
          (S.expected "label")
          (prefixed @Name "$")
    , S.list $ S.el (S.sym "$") >>> S.el (S.datumIso @Name)
@@ -281,7 +281,7 @@ instance S.DatumIso Label where

 instance S.DatumIso Reg where
  datumIso = S.with \g ->
-    S.decorate S.SynVariable >>> S.datumIso @Name >>> S.prismIso
+    S.datumIso @Name >>> S.prismIso
      (S.expected "register")
      (prefixed @Name "%")
    >>> g
@@ -342,9 +342,9 @@ instance S.DatumIso Exp where
    $ S.With (. app)
    $ S.End
    where
-      continue = S.list $
-        S.el (S.decorate S.SynBuiltin >>> S.sym "continue")
-        >>> S.el (S.decorate S.SynProcedure >>> S.datumIso)
+      continue = S.listWithStyle (S.StyleSyntax 1) $
+        S.el (S.sym "continue")
+        >>> S.el S.datumIso
        >>> S.rest S.datumIso
      letrec = S.letLike "letrec" S.datumIso S.datumIso S.datumIso
      if_ = S.ifLike "if"
@@ -365,8 +365,8 @@ instance S.DatumIso Exp where
        >>> S.el (S.datumIso @Kexp)
        >>> S.rest (S.datumIso @Val)
        >>> S.onTail S.swap
-      builtin = S.list $
-        S.el (S.decorate S.SynBuiltin >>> S.sym "builtin")
+      builtin = S.listWithStyle (S.StyleSyntax 1) $
+        S.el (S.sym "builtin")
        >>> S.el (builtinDatumIso id (S.datumIso @Val))
        >>> S.el S.datumIso

@@ -414,15 +414,9 @@ cps = S.makeSx' [| toCPS |]



-deleteFrom :: (Foldable f, Hashable a) => f a -> HashSet a -> HashSet a
-deleteFrom = flip $ foldr HS.delete
-
 insertFrom :: (Foldable f, Hashable a) => f a -> HashSet a -> HashSet a
 insertFrom = flip $ foldr HS.insert

-toHashSetOf :: Hashable a => Getting (Endo (HashSet a)) s a -> s -> HashSet a
-toHashSetOf l = foldrOf l HS.insert mempty
-
 class Free a where
  free :: a -> HashSet Name
  free = freeWithBound mempty
@@ -59,6 +59,4 @@ instance Prefixed Name where
 --- DatumIsos

 instance S.DatumIso Name where
-  datumIso = S.decorate S.SynVariable
-    >>> S.symbol
-    >>> S.iso coerce coerce
+  datumIso = S.symbol >>> S.iso coerce coerce
@@ -90,7 +90,7 @@ hashSetGrammar g =
 instance S.DatumIso Key where
  datumIso = S.with \g ->
    S.list
-      ( S.el (S.symBuiltin "@")
+      ( S.el (S.sym "@")
      >>> S.el (S.datumIso @Name)
      >>> S.el (hashSetGrammar S.datumIso)
      )
@@ -130,7 +130,7 @@ anykw s = S.Flip $ S.PartialIso

 prim_if :: S.DatumIso e => S.DatumGrammar (PrimIf e)
 prim_if = S.with \g ->
-  S.listWithIndentation (NSpecial 1)
+  S.listWithStyle (StyleSyntax 1)
    (S.el (anykw "if")
    >>> S.el S.datumIso
    >>> S.el S.datumIso
@@ -145,7 +145,7 @@ prim_lambda = S.with \g ->
 prim_let
  :: forall e. S.DatumIso e => S.DatumGrammar (PrimLet e)
 prim_let = S.with \g ->
-  (S.listWithIndentation (NSpecial 1) $
+  (S.listWithStyle (StyleSyntax 1) $
    S.el (anykw "let")
    >>> optEl (S.datumIso @Name)
    >>> S.el (S.list $ S.rest $ S.datumIso @(Name,e))
@@ -154,7 +154,7 @@ prim_let = S.with \g ->

 prim_let_syntax :: S.DatumIso e => S.DatumGrammar (PrimLetSyntax e)
 prim_let_syntax = S.with \g ->
-  (S.listWithIndentation (NSpecial 1) $
+  (S.listWithStyle (StyleSyntax 1) $
    S.el (anykw "let-syntax")
    >>> S.el (S.list $ S.rest $ S.datumIso)
    >>> S.rest S.datumIso)
@@ -163,10 +163,10 @@ prim_let_syntax = S.with \g ->
 instance S.DatumIso Bind where
  datumIso = S.match
    $ S.With (\g ->
-      S.list (S.el (S.symBuiltin "L") >>> S.el S.datumIso >>> S.el S.datumIso)
+      S.list (S.el (S.sym "L") >>> S.el S.datumIso >>> S.el S.datumIso)
      >>> g)
    $ S.With (\g ->
-      S.list (S.el (S.symBuiltin "G") >>> S.el S.datumIso)
+      S.list (S.el (S.sym "G") >>> S.el S.datumIso)
      >>> g)
    $ S.End

@@ -90,7 +90,7 @@ hashSetGrammar g =
 instance S.DatumIso Key where
  datumIso = S.with \g ->
    S.list
-      ( S.el (S.symBuiltin "@")
+      ( S.el (S.sym "@")
      >>> S.el (S.datumIso @Name)
      >>> S.el (hashSetGrammar S.datumIso)
      )
@@ -130,7 +130,7 @@ anykw s = S.Flip $ S.PartialIso

 prim_if :: S.DatumIso e => S.DatumGrammar (PrimIf e)
 prim_if = S.with \g ->
-  S.listWithIndentation (NSpecial 1)
+  S.listWithStyle (StyleSyntax 1)
    (S.el (anykw "if")
    >>> S.el S.datumIso
    >>> S.el S.datumIso
@@ -145,7 +145,7 @@ prim_lambda = S.with \g ->
 prim_let
  :: forall e. S.DatumIso e => S.DatumGrammar (PrimLet e)
 prim_let = S.with \g ->
-  (S.listWithIndentation (NSpecial 1) $
+  (S.listWithStyle (StyleSyntax 1) $
    S.el (anykw "let")
    >>> optEl (S.datumIso @Name)
    >>> S.el (S.list $ S.rest $ S.datumIso @(Name,e))
@@ -154,7 +154,7 @@ prim_let = S.with \g ->

 prim_let_syntax :: S.DatumIso e => S.DatumGrammar (PrimLetSyntax e)
 prim_let_syntax = S.with \g ->
-  (S.listWithIndentation (NSpecial 1) $
+  (S.listWithStyle (StyleSyntax 1) $
    S.el (anykw "let-syntax")
    >>> S.el (S.list $ S.rest $ S.datumIso)
    >>> S.rest S.datumIso)
@@ -163,10 +163,10 @@ prim_let_syntax = S.with \g ->
 instance S.DatumIso Bind where
  datumIso = S.match
    $ S.With (\g ->
-      S.list (S.el (S.symBuiltin "L") >>> S.el S.datumIso >>> S.el S.datumIso)
+      S.list (S.el (S.sym "L") >>> S.el S.datumIso >>> S.el S.datumIso)
      >>> g)
    $ S.With (\g ->
-      S.list (S.el (S.symBuiltin "G") >>> S.el S.datumIso)
+      S.list (S.el (S.sym "G") >>> S.el S.datumIso)
      >>> g)
    $ S.End

@@ -11,6 +11,8 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE ViewPatterns #-}
+{- HLINT ignore "Avoid lambda using `infix`" -}
+{- HLINT ignore "Redundant $" -}
 module Gyehoek.Scheme.Syntax
  ( Name(..)
  , Builtin(..)
@@ -36,8 +38,6 @@ module Gyehoek.Scheme.Syntax
  )
  where

-import Data.List (intersperse)
-import Effectful
 import Prelude hiding ((.), id)
 import Control.Category
 import Gyehoek.Sexp qualified as GS
@@ -50,12 +50,7 @@ import Data.Functor.Foldable hiding (fold)
 import qualified Data.HashSet as HS
 import Data.Foldable (fold, toList)
 import Language.Haskell.TH.Quote (QuasiQuoter)
-import Effectful.FileSystem (runFileSystem)
-import qualified Effectful.FileSystem.IO as FS
-import qualified Data.Text.Encoding as T
-import qualified Effectful.FileSystem.IO.ByteString as FB
 import qualified Data.Set.Ordered as O
-import Gyehoek.Sexp.Grammar qualified as Sexp
 import Gyehoek.Sexp.Grammar qualified as S
 import Gyehoek.Sexp.Grammar (DatumIso, G, DataIso, (:-)((:-)))
 import Gyehoek.Prelude
@@ -247,9 +242,7 @@ makeBaseFunctor ''Exp


 instance DatumIso Name where
-  datumIso = S.decorate S.SynVariable
-    >>> S.symbol
-    >>> S.iso coerce coerce
+  datumIso = S.symbol >>> S.iso coerce coerce

 builtinDatumIso
  :: (Text -> Text)
@@ -315,9 +308,9 @@ instance DatumIso Def where
  
 instance DatumIso Trans where
  datumIso = S.with \g ->
-    S.listWithIndentation
-      (S.NSpecial 1)
-      ( S.el (S.symBuiltin "syntax-rules")
+    S.listWithStyle
+      (S.StyleSyntax 1)
+      ( S.el (S.sym "syntax-rules")
      >>> S.Iso (\(ctx:-t) -> ctx:-"...":-t) (\(ctx:-_:-t) -> ctx:-t)
      >>> S.el (S.list $ S.rest (S.datumIso @Name))
      >>> S.rest (S.datumIso @Rule)
@@ -339,8 +332,8 @@ instance DatumIso Exp where
    $ S.With (\app -> app . S.list (S.el S.datumIso >>> S.rest S.datumIso))
    $ S.End
    where
-      letsyntax = S.listWithIndentation (S.NSpecial 1) $
-        S.el (S.symBuiltin "let-syntax")
+      letsyntax = S.listWithStyle (S.StyleSyntax 1) $
+        S.el (S.sym "let-syntax")
        >>> S.el (S.list $ S.rest $ S.datumIso)
        >>> S.el S.datumIso
      lam = S.lambdaLike S.lambdaKeyword S.datumIso (S.el S.datumIso)
@@ -481,16 +474,16 @@ instance DatumIso ImportSet where
    $ S.With (imp "rename" >>>)
    $ S.End
    where
-      imp s = S.list $ S.el (S.symBuiltin s)
+      imp s = S.list $ S.el (S.sym s)
        >>> S.el S.datumIso >>> S.restData S.dataIso
      imp' s = S.list $
-        S.el (S.symBuiltin s)
+        S.el (S.sym s)
        >>> S.el S.datumIso
        >>> S.el S.datumIso

 instance DatumIso ImportDecl where
  datumIso = S.with \decl ->
-    S.list (S.el (S.symBuiltin "import") >>> S.restData S.dataIso)
+    S.list (S.el (S.sym "import") >>> S.restData S.dataIso)
    >>> decl

 instance DataIso Program where
@@ -1,3 +1,4 @@
+{- HLINT ignore "Avoid lambda" -}
 -- | cribbed from sexp-grammar:Language.SexpGrammar.Base
 module Gyehoek.Sexp.Grammar.Base
  ( module Gyehoek.Sexp.Syntax
@@ -8,12 +9,11 @@ module Gyehoek.Sexp.Grammar.Base
  , Grammar(..)
  , DatumGrammar
  , DataGrammar
-  , Grammar
  , ListContext(..)
  , (:-)((:-))
  -- * lists
  , list
-  , listWithIndentation
+  , listWithStyle
  , el
  , rest
  , restData
@@ -23,6 +23,7 @@ module Gyehoek.Sexp.Grammar.Base
  , headTagged1'
  , headTagged1
  , headTagged2
+  , headTagged2'
  -- * atoms
  , simple
  , string
@@ -33,24 +34,22 @@ module Gyehoek.Sexp.Grammar.Base
  , integer
  , int
  , unreadable
-  -- ** symbols
-  , symBuiltin
  -- * TODO: sort lol
  , prismIso
-  , isoIso, decorate
+  , isoIso
  , snoced
  , letLike
  , ifLike
  , lambdaLike
  , lambdaKeyword
  , kappaKeyword
-  , beginLike, headTagged2', dottedList, reifyContext, recontextualise, decontextualise
+  , beginLike
+  , dottedList
+  , reifyContext, recontextualise, decontextualise, redecorate
  ) where

 import Data.InvertibleGrammar
 import Data.InvertibleGrammar.Base
-import Data.InvertibleGrammar.Base as Re
-  ( Grammar(..))
 import Data.InvertibleGrammar.Combinators
 import Gyehoek.Prelude hiding (flipped, traversed, iso, cons, coerced, Iso, Simple, simple)
 import Gyehoek.Sexp.Syntax hiding (position)
@@ -58,7 +57,6 @@ import Gyehoek.Sexp.Print (printDatum')
 import Data.Scientific (Scientific)
 import qualified Data.Scientific as Sci
 import qualified Data.Text as T
-import Control.Monad.RWS (modify)
 import qualified Data.List.NonEmpty as NE
 import Data.Foldable (toList)

@@ -89,14 +87,6 @@ locate =
    (\(_ :- t) -> t)
    (\t -> noAnn :- t)

-modifyAnn :: (Ann -> Ann) -> G (Datum :- t) (Datum :- t)
-modifyAnn f = Iso
-  (\(d:-t) -> (d & ann %~ f) :- t)
-  (\(d:-t) -> (d & ann %~ f) :- t)
-
-decorate :: Syn -> G (Datum :- t) (Datum :- t)
-decorate s = modifyAnn $ #syntax .~ s
-
 newtype ListContext = MkListContext { inner :: List Datum }

 unexpectedSimple :: Simple -> Mismatch
@@ -108,7 +98,7 @@ unexpectedDatum = unexpected . printDatum'
 list
  :: G (ListContext :- t) (ListContext :- t')
  -> G (Datum :- t) t'
-list = listWithIndentation Ordinary
+list = listWithStyle StyleData

 -- |
 -- >>> let grammar = with \g -> dottedList (el int) int >>> g
@@ -143,11 +133,11 @@ dottedList g final = begin >>> Dive (onTail (g >>> end) >>> final)
           [] -> Right t
           d:_ -> Left $ unexpectedDatum d)

-listWithIndentation
-  :: Indentation
+listWithStyle
+  :: Style
  -> G (ListContext :- t) (ListContext :- t')
  -> G (Datum :- t) t'
-listWithIndentation ind g = begin >>> Dive (g >>> end)
+listWithStyle ind g = begin >>> Dive (g >>> end)
  where
    begin = locate >>> partialOsi
      (\case
@@ -378,33 +368,36 @@ int = integer >>> iso fromIntegral fromIntegral

 -- high-level combinators

+redecorate :: Style -> G (Datum :- t) t' -> G (Datum :- t) t'
+redecorate sty g = iso (styleWith sty) (styleWith sty) >>> g
+
 headTagged0 :: Text -> G (Datum :- t) t
-headTagged0 s = list $ el (symProcedure s)
+headTagged0 s = listWithStyle StyleCode $ el (sym s)

 headTagged0' :: Text -> DatumGrammar a -> G (Datum :- t) (List a :- t)
-headTagged0' s gt = list $ el (symProcedure s) >>> rest gt
+headTagged0' s gt = listWithStyle StyleCode $ el (sym s) >>> rest gt

 headTagged1 :: Text -> DatumGrammar a -> G (Datum :- t) (a :- t)
-headTagged1 s g1 = list $ el (symProcedure s) >>> el g1
+headTagged1 s g1 = listWithStyle StyleCode $ el (sym s) >>> el g1

 headTagged1'
  :: Text
  -> DatumGrammar a -> DatumGrammar b
  -> G (Datum :- t) (List b :- a :- t)
-headTagged1' s g1 gt = list $ el (symProcedure s) >>> el g1 >>> rest gt
+headTagged1' s g1 gt = list $ el (sym s) >>> el g1 >>> rest gt

 headTagged2
  :: Text
  -> DatumGrammar a -> DatumGrammar b
  -> G (Datum :- t) (b :- a :- t)
-headTagged2 s g1 g2 = list $ el (symProcedure s) >>> el g1 >>> el g2
+headTagged2 s g1 g2 = listWithStyle StyleCode $ el (sym s) >>> el g1 >>> el g2

 headTagged2'
  :: Text
  -> DatumGrammar a -> DatumGrammar b -> DatumGrammar c
  -> G (Datum :- t) (List c :- b :- a :- t)
 headTagged2' s g1 g2 gt =
-  list $ el (symProcedure s) >>> el g1 >>> el g2 >>> rest gt
+  listWithStyle StyleCode $ el (sym s) >>> el g1 >>> el g2 >>> rest gt

 ifLike
  -- | keyword
@@ -417,12 +410,8 @@ ifLike
  -> DatumGrammar c
  -> G (Datum :- t) (c :- b :- a :- t)
 ifLike kw c t f =
-  listWithIndentation (NSpecial 1) $
-    el (symBuiltin kw) >>> el c >>> el t >>> el f
-
-symBuiltin, symProcedure :: Text -> G (Datum :- t) t
-symBuiltin s = decorate SynBuiltin >>> sym s
-symProcedure s = decorate SynProcedure >>> sym s
+  listWithStyle (StyleSyntax 1) $
+    el (sym kw) >>> el c >>> el t >>> el f

 letLike
  :: Text
@@ -430,8 +419,8 @@ letLike
  -> (forall t. G (Datum :- t) (b :- t))
  -> G (Datum :- List (a, b) :- t1) t2
  -> G (Datum :- t1) t2
-letLike kw name rhs e = listWithIndentation (NSpecial 1) $
-  el (symBuiltin kw) >>> el bindings >>> el e
+letLike kw name rhs e = listWithStyle (StyleSyntax 1) $
+  el (sym kw) >>> el bindings >>> el e
  where
    bindings = list $ rest binding
    binding :: G (Datum :- t) ((_, _) :- t)
@@ -442,8 +431,8 @@ lambdaLike
  -> G (Datum :- t1) (a :- t2)
  -> G (ListContext :- a :- t2) (ListContext :- t3)
  -> G (Datum :- t1) t3
-lambdaLike kw formals body = listWithIndentation (NSpecial 1) $
-  el (decorate SynBuiltin >>> kw)
+lambdaLike kw formals body = listWithStyle (StyleSyntax 1) $
+  el kw
  >>> el formals
  >>> body

@@ -458,8 +447,8 @@ beginLike
  -> G (ListContext :- t) (ListContext :- t')
  -> G (Datum :- t) t'
 beginLike kw g =
-  listWithIndentation (NSpecial 0) $
-    el (symBuiltin kw) >>> g
+  listWithStyle (StyleSyntax 0) $
+    el (sym kw) >>> g

 -- | define a printed syntax for an object which cannot be read.
 unreadable
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 module Gyehoek.Sexp.Print
  ( printDatum
  , printDatumW
@@ -6,26 +7,34 @@ module Gyehoek.Sexp.Print
  , printData'
  , htmlDatum
  , htmlData
+  , putDoc
  ) where

 import Gyehoek.Sexp.Syntax
 import Prettyprinter
-import Data.Functor.Foldable
-import qualified Control.Comonad.Trans.Cofree as F
-import Prettyprinter.Util
-import Gyehoek.Prelude hiding (Simple, (:<))
-import Data.Foldable (traverse_, toList)
+import Gyehoek.Prelude hiding (Simple)
 import qualified Prettyprinter.Render.Terminal as ANSI
 import System.IO (stdout)
 import Prettyprinter.Render.Terminal (Color(..), color, italicized, AnsiStyle, bold, colorDull)
 import Prettyprinter.Render.Text (renderStrict)
-import qualified Data.Scientific as Sci
 import Data.List (intersperse)
 import Lucid
 import Prettyprinter.Render.Util.SimpleDocTree (treeForm)
 import Prettyprinter.Lucid (renderHtml)
+import Data.Foldable (toList)
+import qualified Data.Scientific as Sci


+data Syn
+  = SynSyntax
+  | SynProcedure
+  | SynParen Int
+  | SynString
+  | SynConstant
+  | SynVariable
+  | SynNone
+  deriving (Show, Read, Data, Generic, Eq)
+
 printDatum' :: Datum -> Text
 printDatum' =
  prettyDatum 0
@@ -83,7 +92,7 @@ printDatumW w =

 prettyDatum :: Int -> Datum -> Doc Syn
 prettyDatum depth datum = case datum of
-  Simple simp -> annotate (datum ^. syntax) $ prettySimple depth simp
+  Simple simp -> prettySimple depth simp
  DotList xs x ->
    pparen depth . group . align $
      vsep [ vsep (prettyDatum (depth+1) <$> toList xs)
@@ -91,35 +100,33 @@ prettyDatum depth datum = case datum of
           , prettyDatum (depth+1) x
           ]
      
-  List' indent xs ->
-    case indent of
-      NSpecial n | keyword:args <- xs ->
-        let (specialArgs,body) = splitAt n args
-        in pparen depth . nest 2 . vsep $
-            [ group . nest 2 . hcat $
-              [ prettyDatum (depth+1) keyword
-              , if null specialArgs then mempty else softline
-              , hsep $ prettyDatum (depth+1) <$> specialArgs
-              ]
-            , vsep $ prettyDatum (depth+1) <$> body
+  List' sty xs -> case sty of
+    StyleSyntax n | keyword:args <- xs ->
+      let (specialArgs,body) = splitAt n args
+      in pparen depth . nest 2 . vsep $
+          [ group . nest 2 . hcat $
+            [ annotate SynSyntax $ prettyDatum (depth+1) keyword
+            , if null specialArgs then mempty else softline
+            , hsep $ prettyDatum (depth+1) <$> specialArgs
            ]
-      Ordinary; NSpecial _ -> pparen depth $
-        group . align . vsep $
-          prettyDatum (depth+1) <$> xs
+          , vsep $ prettyDatum (depth+1) <$> body
+          ]
+    StyleCode | f:args <- xs -> pparen depth $
+      group . align . vsep . (_head %~ annotate SynProcedure) $
+        prettyDatum (depth+1) <$> xs
+    StyleData; StyleSyntax _; StyleCode -> pparen depth $
+      group . align . vsep $
+        prettyDatum (depth+1) <$> xs
  _ -> error [i|unimplemented: #{datum}|]

 pparen depth = enclose (delim depth "(") (delim depth ")")
 delim depth = annotate (SynParen depth)

-delimited :: Int -> Doc Syn -> Doc Syn -> List (Doc Syn) -> Doc Syn
-delimited depth open close =
-  encloseSep (delim depth open) (delim depth close) softline
-
 prettySimple :: Int -> Simple -> Doc Syn
 prettySimple depth = \case
  SimpleBoolean b -> annotate SynConstant $ if b then "#t" else "#f"
-  SimpleNumber n ->
-    Sci.floatingOrInteger n
+  SimpleNumber n -> n
+    & Sci.floatingOrInteger @Double @Integer
    & either viaShow viaShow
    & annotate SynConstant
  SimpleString s -> annotate SynString $ viaShow s
@@ -132,7 +139,7 @@ putDoc = ANSI.renderIO stdout

 highlightAnsi :: Syn -> AnsiStyle
 highlightAnsi = \case
-  (SynBuiltin; SynMacro) -> color Magenta <> italicized <> bold
+  SynSyntax -> color Magenta <> italicized <> bold
  SynProcedure -> color Blue
  SynConstant -> color Yellow
  SynParen n -> colorDull $ rainbow ^?! ix n
@@ -144,8 +151,7 @@ highlightHtml :: Syn -> Html () -> Html ()
 highlightHtml syn = span_ [class_ synClass]
  where
    synClass = case syn of
-      SynBuiltin -> "syn-builtin"
-      SynMacro -> "syn-macro"
+      SynSyntax -> "syn-builtin"
      SynConstant -> "syn-constant"
      SynString -> "syn-string"
      SynProcedure -> "syn-procedure"
@@ -254,9 +254,9 @@ compoundDatum = choice
 list :: P Compound
 list = label "list" . between lparen rparen $ do
  optional datum >>= \case
-    Nothing -> pure $ ListF Ordinary []
+    Nothing -> pure $ ListF StyleData []
    Just x -> do
      xs <- many datum
      optional (dot *> datum) >>= \case
-        Nothing -> pure $ ListF Ordinary (x:xs)
+        Nothing -> pure $ ListF StyleData (x:xs)
        Just y -> pure $ DotListF (x:|xs) y
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ApplicativeDo #-}
+{- HLINT ignore "Use newtype instead of data" -}
 module Gyehoek.Sexp.Syntax
  ( DatumF(..)
  , Simple(..)
@@ -13,8 +14,7 @@ module Gyehoek.Sexp.Syntax
  , Cofree((:<))
  , Fix(..)
  , Compound
-  , Indentation(..)
-  , Syn(..)
+  , Style(..)
  , pattern Simple
  , pattern Compound
  , pattern Labeled
@@ -25,10 +25,8 @@ module Gyehoek.Sexp.Syntax
  , pattern Vector
  , pattern DotList
  , pattern Gyehoek.Sexp.Syntax.List
-  , syntax
-  , indentation
-  , adorn
-  , indentWith
+  , style
+  , styleWith
  , pattern Unreadable
  , pattern Bytevector
  , pattern Symbol
@@ -45,10 +43,10 @@ module Gyehoek.Sexp.Syntax
  , stripAnn
  ) where

-import Language.Haskell.TH.Syntax (Lift (lift), liftData)
+import Language.Haskell.TH.Syntax (Lift (lift))
 import Data.Scientific (Scientific)
 import Data.ByteString (ByteString)
-import Gyehoek.Prelude hiding ((:<), Simple)
+import Gyehoek.Prelude hiding (Simple)
 import Text.Megaparsec.Pos (SourcePos(..), sourcePosPretty)
 import Control.Comonad.Cofree (Cofree((:<)), _extract, _unwrap)
 import Data.Fix (Fix (..))
@@ -88,7 +86,7 @@ data Simple
  deriving anyclass (NFData)

 data CompoundF a
-  = ListF Indentation (List a)
+  = ListF Style (List a)
  | DotListF (NonEmpty a) a
  | VectorF (List a)
  | AbbrevF Prefix a
@@ -122,33 +120,21 @@ newtype Label = MkLabel Natural
 type Datum = Cofree DatumF Ann
 type Compound = CompoundF Datum

-data Indentation
-  = NSpecial Int
-  | Ordinary
+data Style
+  = StyleSyntax Int
+  | StyleCode
+  | StyleData
  deriving stock (Data, Eq, Generic, Show, Lift, Read)
  deriving anyclass (NFData)

-data Syn
-  = SynMacro
-  | SynBuiltin
-  | SynProcedure
-  | SynParen Int
-  | SynString
-  | SynConstant
-  | SynVariable
-  | SynNone
-  deriving (Show, Read, Data, Generic, Eq, Lift)
-
 data Ann = MkAnn
-  { syntax :: Syn
-  , position :: Maybe SourcePos
+  { position :: Maybe SourcePos
  }
  deriving (Show, Data, Eq, Generic)

 noAnn :: Ann
 noAnn = MkAnn
-  { syntax = SynNone
-  , position = Nothing
+  { position = Nothing
  }

 -- requisite of the Pretty instance for invertible-grammar's error type.
@@ -160,13 +146,6 @@ deriveEq1 ''CompoundF
 deriveShow1 ''DatumF
 deriveEq1 ''DatumF

-
--- optics
-
-- affine
-cdr :: Traversal' Datum Datum
-cdr k (a :< CompoundF (ListF ind xs)) = _
-

 --- modification and extraction of annotations

@@ -176,23 +155,18 @@ ann = _extract
 dat :: Lens' Datum (DatumF Datum)
 dat = _unwrap

-syntax :: Lens' Datum Syn
-syntax = ann . #syntax
-
 position :: Lens' Datum (Maybe SourcePos)
 position = ann . #position

-indentation :: Traversal' Datum Indentation
-indentation k (syn :< CompoundF (ListF ind xs)) = do
+-- affine
+style :: Traversal' Datum Style
+style k (syn :< CompoundF (ListF ind xs)) = do
  ind' <- k ind
  pure $ syn :< CompoundF (ListF ind' xs)
-indentation k a = pure a
+style k a = pure a

-adorn :: Syn -> Datum -> Datum
-adorn = set syntax
-
-indentWith :: Indentation -> Datum -> Datum
-indentWith = set indentation
+styleWith :: Style -> Datum -> Datum
+styleWith = set style

 stripAnn :: Datum -> Fix DatumF
 stripAnn = hoist tailF
@@ -226,9 +200,9 @@ pattern Meta x <- _ :< MetaF x

 pattern List :: List Datum -> Datum
 pattern List a <- _ :< CompoundF (ListF _ a)
-  where List a = noAnn :< CompoundF (ListF Ordinary a)
+  where List a = noAnn :< CompoundF (ListF StyleData a)

-pattern List' :: Indentation -> List Datum -> Datum
+pattern List' :: Style -> List Datum -> Datum
 pattern List' ind a <- _ :< CompoundF (ListF ind a)
  where List' ind a = noAnn :< CompoundF (ListF ind a)

@@ -244,12 +218,25 @@ pattern Abbrev :: Prefix -> Datum -> Datum
 pattern Abbrev p a <- _ :< CompoundF (AbbrevF p a)
  where Abbrev p a = noAnn :< CompoundF (AbbrevF p a)

+pattern Boolean :: Bool -> Datum
 pattern Boolean a = Simple (SimpleBoolean a)
+
+pattern Number :: Scientific -> Datum
 pattern Number a = Simple (SimpleNumber a)
+
+pattern Character :: Char -> Datum
 pattern Character a = Simple (SimpleCharacter a)
+
+pattern String :: Text -> Datum
 pattern String a = Simple (SimpleString a)
+
+pattern Symbol :: Text -> Datum
 pattern Symbol a = Simple (SimpleSymbol a)
+
+pattern Bytevector :: ByteString -> Datum
 pattern Bytevector a = Simple (SimpleBytevector a)
+
+pattern Unreadable :: Text -> Datum
 pattern Unreadable a = Simple (SimpleUnreadable a)


@@ -24,19 +24,19 @@ thinWide name x = testGroup name
  , tcaseW 4 (name <> "-thin") x
  ]

-datumBegin xs = S.indentWith (S.NSpecial 0) . S.List $
-  (S.adorn S.SynBuiltin . S.Symbol $ "begin") : xs
+datumBegin xs = S.styleWith (S.StyleSyntax 0) . S.List $
+  S.Symbol "begin" : xs

 datumLambda formals body =
-  S.indentWith (S.NSpecial 1) . S.List $
-  (S.adorn S.SynBuiltin . S.Symbol $ "lambda") : formals : body
+  S.styleWith (S.StyleSyntax 1) . S.List $
+  S.Symbol "lambda" : formals : body

-test_print = testGroup "sexp pretty printer" $
+test_print = testGroup "sexp pretty printer"
  [ tcase "null" $ S.List []
  , thinWide "simple-list" $
    S.List [ S.Symbol s | s <- ["가","나","다","라"] ]
  , thinWide "begin-nonempty" $
-    S.indentWith (S.NSpecial 0) $
+    S.styleWith (S.StyleSyntax 0) $
    datumBegin [ S.Symbol "책을"
           , S.Symbol "더"
           , S.Symbol "먹으세요~!"