From c6036ffbb446d8c00e31dff1ff2b401609b4438b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Sun, 6 Sep 2026 20:40:37 -0600 Subject: [PATCH] parse/print libraries --- doc/libraries.org | 9 ++++ src/Gyehoek/Scheme/Syntax.hs | 88 ++++++++++++++++++++++++++++++-- src/Gyehoek/Sexp/Grammar.hs | 4 ++ src/Gyehoek/Sexp/Grammar/Base.hs | 14 ++++- 4 files changed, 111 insertions(+), 4 deletions(-) create mode 100644 doc/libraries.org diff --git a/doc/libraries.org b/doc/libraries.org new file mode 100644 index 0000000..8e1367d --- /dev/null +++ b/doc/libraries.org @@ -0,0 +1,9 @@ +#+title: on libraries + +R⁷RS leaves it unspecified how exactly libraries correspond to files: + +#+begin_quote +Programs and libraries are typically stored in files, although in some implementations they can be entered interactively into a running Scheme system. Other paradigms are possible. Implementations which store libraries in files should document the mapping from the name of a library to its location in the file system. +#+end_quote + +thus the implementation of ~define-library~ is open to much interpretation. we could possibly define libraries as first-class objects, or deal with them statically. the former case is appealing to me, as it could massively simplify interactive use. diff --git a/src/Gyehoek/Scheme/Syntax.hs b/src/Gyehoek/Scheme/Syntax.hs index c6b599a..5124141 100644 --- a/src/Gyehoek/Scheme/Syntax.hs +++ b/src/Gyehoek/Scheme/Syntax.hs @@ -10,6 +10,7 @@ {-# LANGUAGE OrPatterns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE ViewPatterns #-} module Gyehoek.Scheme.Syntax ( Name(..) , Prim(..) @@ -53,6 +54,8 @@ import Gyehoek.Sexp.Grammar qualified as Sexp import Gyehoek.Sexp.Grammar qualified as S import Gyehoek.Sexp.Grammar (DatumIso, G, DataIso, (:-)((:-))) import Gyehoek.Prelude +import Control.Lens.Extras (is) +import qualified Data.Scientific as Sci newtype Name = MkName { inner :: Text } @@ -130,8 +133,37 @@ data CommandOrDef deriving stock (Show, Generic, Data) deriving anyclass (NFData) -newtype Program = MkProgram - { commandsAndDefs :: List CommandOrDef +newtype LibName = MkLibName { inner :: NonEmpty Name } + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + +data ImportSet + = ImportLib LibName + | ImportOnly ImportSet (NonEmpty Name) + | ImportExcept ImportSet (NonEmpty Name) + | ImportPrefix ImportSet Name + | ImportRename ImportSet (NonEmpty (Name, Name)) + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + +newtype ImportDecl = MkImportDecl (NonEmpty ImportSet) + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + +data LibDecl + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + +data Lib = MkLib + { name :: LibName + , decls :: List LibDecl + } + deriving stock (Show, Generic, Data) + deriving anyclass (NFData) + +data Program = MkProgram + { imports :: List ImportDecl + , commandsAndDefs :: List CommandOrDef } deriving stock (Show, Generic, Data) deriving anyclass (NFData) @@ -244,8 +276,58 @@ instance DatumIso CommandOrDef where $ S.With (\_Begin -> _Begin . S.beginLike "begin" (S.rest S.datumIso)) $ S.End +instance DatumIso LibName where + datumIso = S.with \g -> + S.list (S.restData $ S.nonEmptyData comp) + >>> g + where + comp = S.partialOsi + (\case + S.Symbol s -> Right $ MkName s + S.Number (Sci.floatingOrInteger @Double @Int -> Right n) + | n > 0 -> Right $ MkName [i|#{n}|] + _ -> Left $ S.expected "library name part" + ) + \(MkName s) -> S.Symbol s + +instance DatumIso ImportSet where + datumIso = S.match + $ S.With (S.datumIso @LibName >>>) + $ S.With (imp "only" >>>) + $ S.With (imp "except" >>>) + $ S.With (imp' "prefix" >>>) + $ S.With (imp "rename" >>>) + $ S.End + where + imp s = S.list $ S.el (S.symBuiltin s) + >>> S.el S.datumIso >>> S.restData S.dataIso + imp' s = S.list $ + S.el (S.symBuiltin 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) + >>> decl + instance DataIso Program where - dataIso = S.dataIso @(List CommandOrDef) >>> S.iso coerce coerce + dataIso = S.with \g -> + splitG + >>> S.onHead (S.sealed S.dataIso) + >>> S.onTail (S.onHead . S.sealed $ S.dataIso) + >>> g + where + isImport = \case + S.List (S.Symbol "import" : _) -> True + _ -> False + splitG :: G (List S.Datum :- t) (List S.Datum :- List S.Datum :- t) + splitG = S.Iso + (\(xs:-t) -> + let (ys,zs) = span isImport xs + in zs :- ys :- t + ) + \(zs:-ys:-t) -> (ys ++ zs) :- t -- utilities diff --git a/src/Gyehoek/Sexp/Grammar.hs b/src/Gyehoek/Sexp/Grammar.hs index c220703..a945cab 100644 --- a/src/Gyehoek/Sexp/Grammar.hs +++ b/src/Gyehoek/Sexp/Grammar.hs @@ -49,6 +49,7 @@ import qualified Data.Vector as V import Data.String (IsString (fromString)) import qualified Data.Text as T import System.Environment (lookupEnv) +import Data.Foldable (toList) toDatum :: Jalmot :> es => DatumGrammar a -> a -> Eff es Datum @@ -187,5 +188,8 @@ instance DatumIso a => DataIso (V.Vector a) where dataIso = iso fromList V.toList >>> (onHead . traversed . sealed $ datumIso @a) +instance DatumIso a => DataIso (NonEmpty a) where + dataIso = nonEmptyData datumIso + instance (DatumIso a, DatumIso b) => DatumIso (a, b) where datumIso = with \tup2 -> list (el datumIso >>> el datumIso) >>> tup2 diff --git a/src/Gyehoek/Sexp/Grammar/Base.hs b/src/Gyehoek/Sexp/Grammar/Base.hs index 3d81332..82fb8f9 100644 --- a/src/Gyehoek/Sexp/Grammar/Base.hs +++ b/src/Gyehoek/Sexp/Grammar/Base.hs @@ -17,6 +17,7 @@ module Gyehoek.Sexp.Grammar.Base , el , rest , restData + , nonEmptyData , headTagged0' , headTagged0 , headTagged1' @@ -32,6 +33,8 @@ module Gyehoek.Sexp.Grammar.Base , integer , int , unreadable + -- ** symbols + , symBuiltin -- * TODO: sort lol , prismIso , isoIso, decorate @@ -49,7 +52,7 @@ import Data.InvertibleGrammar.Base import Data.InvertibleGrammar.Base as Re ( Grammar(..)) import Data.InvertibleGrammar.Combinators -import Gyehoek.Prelude hiding (iso, cons, coerced, Iso, Simple, simple) +import Gyehoek.Prelude hiding (traversed, iso, cons, coerced, Iso, Simple, simple) import Gyehoek.Sexp.Syntax hiding (position) import Gyehoek.Sexp.Print (printDatum') import Data.Scientific (Scientific) @@ -57,6 +60,7 @@ 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) -- $setup @@ -238,6 +242,14 @@ restData g = >>> g >>> push (MkListContext []) (const True) mempty +nonEmptyData :: DatumGrammar a -> DataGrammar (NonEmpty a) +nonEmptyData g = partialOsi + (\case + [] -> Left $ expected "non-empty sequence" + x:xs -> Right $ x:|xs) + toList + >>> (onHead . traversed . sealed $ g) + snoced :: Snoc s s a a => Grammar p (s :- a :- t) (s :- t)