-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
0846ae6
commit ab64dfb
Showing
8 changed files
with
113 additions
and
71 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
48 changes: 48 additions & 0 deletions
48
Pinafore/pinafore-language/lib/Pinafore/Language/Interpret/SpecialForm.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,48 @@ | ||
module Pinafore.Language.Interpret.SpecialForm | ||
( interpretSpecialForm | ||
) where | ||
|
||
import Import | ||
import Pinafore.Language.Error | ||
import Pinafore.Language.Interpret.Type | ||
import Pinafore.Language.Interpreter | ||
import Pinafore.Language.SpecialForm | ||
import Pinafore.Language.Type | ||
|
||
specialFormArg :: QAnnotation t -> SyntaxAnnotation -> ComposeInner Maybe QInterpreter t | ||
specialFormArg AnnotAnchor (SAAnchor anchor) = return anchor | ||
specialFormArg AnnotNonpolarType (SAType st) = lift $ interpretNonpolarType st | ||
specialFormArg AnnotPositiveType (SAType st) = lift $ interpretType @'Positive st | ||
specialFormArg AnnotNegativeType (SAType st) = lift $ interpretType @'Negative st | ||
specialFormArg _ _ = liftInner Nothing | ||
|
||
specialFormArgs :: ListType QAnnotation lt -> [SyntaxAnnotation] -> ComposeInner Maybe QInterpreter (ListProduct lt) | ||
specialFormArgs NilListType [] = return () | ||
specialFormArgs (ConsListType t tt) (a:aa) = do | ||
v <- specialFormArg t a | ||
vv <- specialFormArgs tt aa | ||
return (v, vv) | ||
specialFormArgs _ _ = liftInner Nothing | ||
|
||
showSA :: SyntaxAnnotation -> NamedText | ||
showSA (SAType _) = "type" | ||
showSA (SAAnchor _) = "anchor" | ||
|
||
showAnnotation :: QAnnotation a -> NamedText | ||
showAnnotation AnnotAnchor = "anchor" | ||
showAnnotation AnnotNonpolarType = "type" | ||
showAnnotation AnnotPositiveType = "type" | ||
showAnnotation AnnotNegativeType = "type" | ||
|
||
interpretSpecialForm :: FullNameRef -> Maybe QSpecialForm -> [SyntaxAnnotation] -> QInterpreter QExpression | ||
interpretSpecialForm name msf annotations = do | ||
MkQSpecialForm largs val <- | ||
case msf of | ||
Just sf -> return sf | ||
Nothing -> lookupSpecialForm name | ||
margs <- unComposeInner $ specialFormArgs largs annotations | ||
case margs of | ||
Just args -> val args | ||
Nothing -> | ||
throw $ | ||
SpecialFormWrongAnnotationsError name (listTypeToList showAnnotation largs) (fmap showSA annotations) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters