Happy parse lex #1

Merged
msydneyslaga merged 7 commits from happy-parse-lex into main 2023-11-20 14:09:33 -07:00
12 changed files with 330 additions and 440 deletions
Showing only changes of commit ac55a1908c - Show all commits

View File

@@ -0,0 +1,3 @@
Parsing and the Layout System
=============================

View File

@@ -1,3 +0,0 @@
Parser Combinators
==================

View File

@@ -22,11 +22,13 @@ library
, TIM , TIM
other-modules: Data.Heap other-modules: Data.Heap
, Data.Pretty , Data.Pretty
, Control.Parser
, Core.Syntax , Core.Syntax
, Core.Parse , Core.Parse
, Core.Lex
, Core.TH , Core.TH
, Core.Examples
, Core.Lex
build-tool-depends: happy:happy, alex:alex
-- other-extensions: -- other-extensions:
build-depends: base ^>=4.18.0.0 build-depends: base ^>=4.18.0.0
@@ -34,6 +36,8 @@ library
, microlens , microlens
, microlens-th , microlens-th
, template-haskell , template-haskell
-- required for happy
, array
hs-source-dirs: src hs-source-dirs: src
default-language: GHC2021 default-language: GHC2021

View File

@@ -1,106 +0,0 @@
{-|
Module : Control.Parser
Description : Parser combinators
This module implements an interface for parser *types*, used in lexical analysis
and parsing. For the implementation of the rlp language's parser, see 'Parse'.
-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE BlockArguments, LambdaCase #-}
module Control.Parser
( ParserT
, runParserT
, satisfy
, char
, spaces
, surround
, string
, match
, termMany
, sepSome
-- * Control.Applicative re-exports
, (<|>)
, many
, some
, empty
)
where
----------------------------------------------------------------------------------
import Control.Applicative
import Control.Arrow ((***))
import Control.Monad
import Data.Char
----------------------------------------------------------------------------------
newtype ParserT i m o = ParserT { runParserT :: i -> m (i, o) }
deriving (Functor)
instance (Monad m) => Applicative (ParserT i m) where
pure a = ParserT \i -> pure (i, a)
m <*> k = ParserT \i -> do
(i',f) <- runParserT m i
fmap (id *** f) $ runParserT k i'
instance (MonadPlus m) => Alternative (ParserT i m) where
empty = ParserT $ const empty
ParserT m <|> ParserT k = ParserT $ \i ->
m i <|> k i
instance (MonadPlus m) => MonadPlus (ParserT i m)
instance (Monad m) => Monad (ParserT i m) where
m >>= k = ParserT $ \i -> do
(i',a) <- runParserT m i
runParserT (k a) i'
instance (MonadFail m) => MonadFail (ParserT i m) where
fail s = ParserT $ \i -> fail s
----------------------------------------------------------------------------------
eof :: (MonadPlus m) => ParserT [a] m ()
eof = ParserT $ \case
[] -> pure ([], ())
_ -> empty
-- TODO: generalise to non-lists
satisfy :: (MonadPlus m) => (a -> Bool) -> ParserT [a] m a
satisfy p = ParserT $ \case
(x:xs) | p x -> pure (xs,x)
_ -> empty
match :: (MonadPlus m) => (a -> Maybe b) -> ParserT [a] m b
match f = ParserT $ \case
(x:xs) -> case f x of
Just b -> pure (xs,b)
Nothing -> empty
[] -> empty
termMany :: (MonadPlus m) => ParserT i m t -> ParserT i m o -> ParserT i m [o]
termMany t a = many (a <* t)
sepSome :: (MonadPlus m) => ParserT i m t -> ParserT i m o -> ParserT i m [o]
sepSome s a = (:) <$> a <*> many (s *> a)
char :: (MonadPlus m, Eq a) => a -> ParserT [a] m a
char c = satisfy (==c)
string :: (MonadPlus m, Eq a) => [a] -> ParserT [a] m [a]
string s = sequenceA $ char <$> s
----------------------------------------------------------------------------------
surround :: (MonadPlus m)
=> ParserT i m l
-> ParserT i m r
-> ParserT i m c
-> ParserT i m c
surround l r c = l *> c <* r
spaces :: (MonadPlus m) => ParserT String m Int
spaces = length <$> many (satisfy (==' '))

22
src/Core/Examples.hs Normal file
View File

@@ -0,0 +1,22 @@
{-# LANGUAGE QuasiQuotes #-}
module Core.Examples where
----------------------------------------------------------------------------------
import Core.Syntax
import Core.TH
----------------------------------------------------------------------------------
{-
letrecExample :: Program
letrecExample = [core|
pair x y f = f x y;
fst p = p k;
snd p = p k1;
f x y = letrec
{ a = pair x b;
; b = pair y a
} in fst (snd (snd (snd a)));
main = f 3 4;
|]
-}

View File

@@ -1,141 +0,0 @@
{-|
Module : Core.Lex
Description : Core language lexer
-}
module Core.Lex
( CoreToken(..)
, Result(..)
, lexCore
)
where
----------------------------------------------------------------------------------
import Control.Parser
import Control.Applicative
import Control.Monad
import Data.Char
import Data.Functor
import Core.Syntax (Name)
----------------------------------------------------------------------------------
type CoreLexer = ParserT String Result
data Result a = Success a
| Error String Int Int
deriving (Show)
-- TODO: whitespace-sensitive layout
data CoreToken = TokLitInt Int
| TokEquals
| TokLBrace
| TokRBrace
| TokSemicolon
| TokLParen
| TokRParen
| TokLambda
| TokArrow
| TokCase
| TokOf
| TokLet
| TokLetRec
| TokIn
| TokCName Name
| TokName Name
deriving (Show, Eq)
instance Functor Result where
fmap f (Success a) = Success (f a)
fmap _ (Error s l c) = Error s l c
instance Foldable Result where
foldr f z (Success a) = a `f` z
foldr _ z (Error _ _ _) = z
instance Traversable Result where
traverse k (Success a) = fmap Success (k a)
traverse _ (Error s l c) = pure $ Error s l c
instance Applicative Result where
pure = Success
liftA2 f (Success a) (Success b) = Success $ f a b
liftA2 _ (Error s l c) _ = Error s l c
liftA2 _ _ (Error s l c) = Error s l c
instance Alternative Result where
empty = Error "some error! this is a temporary system lol" 0 0
(Success a) <|> _ = Success a
_ <|> b = b
instance Monad Result where
Success a >>= k = k a
Error s l c >>= _ = Error s l c
instance MonadPlus Result
instance MonadFail Result where
fail s = Error s 0 0
----------------------------------------------------------------------------------
lexCore :: String -> Result [CoreToken]
lexCore = fmap snd . runParserT (many (token <* spaces))
token :: CoreLexer CoreToken
token = litInt
<|> lbrace
<|> rbrace
<|> semicolon
<|> lparen
<|> rparen
<|> equals
<|> lambda
<|> arrow
<|> _case
<|> _of
<|> letrec
<|> _let
<|> _in
<|> cName
<|> name
----------------------------------------------------------------------------------
litInt, equals, lparen, rparen, lambda,
arrow, _case, _of, _let, letrec, _in, cName, name :: CoreLexer CoreToken
litInt = TokLitInt . value <$> some (satisfy isDigit)
where
value = foldl (\acc a -> 10*acc + digitToInt a) 0
semicolon = (semis <|> nls) $> TokSemicolon
where
nls = head <$> some (char '\n')
semis = char ';' <* many (char '\n')
equals = char '=' $> TokEquals
lbrace = char '{' $> TokLBrace
rbrace = char '}' $> TokRBrace
lparen = char '(' $> TokLParen
rparen = char ')' $> TokRParen
lambda = (char '\\' <|> char 'λ') $> TokLambda
arrow = string "->" $> TokArrow
_case = string "case" $> TokCase
_of = string "of" $> TokOf
_let = string "let" $> TokLet
letrec = string "letrec" $> TokLetRec
_in = string "in" $> TokIn
cName = TokCName <$> ((:) <$> cNameHead <*> properNameTail)
where cNameHead = satisfy isUpper
name = some (satisfy p) <&> TokName
where p c = not (isSpace c) && c `notElem` ";{}()"
properName :: CoreLexer Name
properName = (:) <$> nameHead <*> properNameTail
where nameHead = satisfy isLetter
properNameTail :: CoreLexer Name
properNameTail = many . satisfy $ \c ->
isLetter c || isDigit c || c == '_'

107
src/Core/Lex.x Normal file
View File

@@ -0,0 +1,107 @@
{
module Core.Lex
( CoreToken(..)
, lexCore
)
where
import Core.Syntax
import Lens.Micro
}
%wrapper "monadUserState"
$digit = 0-9
$alpha = [a-zA-Z]
$special = [\*\^\%\$#@!\<\>\+\-\=\/&\|\\\.]
$nameTail = [ $alpha $digit \_ \' ]
rlp :-
-- tokens :-
-- $white+ ;
-- "--" ~$special .* ;
-- module { const TokenModule }
-- where { const TokenWhere }
-- let { const TokenLet }
-- letrec { const TokenLetrec }
-- in { const TokenIn }
-- case { const TokenCase }
-- of { const TokenOf }
-- $digit+ { TokenLitInt . read @Int }
-- "," { const TokenComma }
-- "(" { const TokenLParen }
-- ")" { const TokenRParen }
-- "{" { const TokenLBrace }
-- "}" { const TokenRBrace }
-- "\\" { const TokenLambda }
-- "λ" { const TokenLambda }
-- ";" { const TokenSemicolon }
-- $special+ { lexSym }
-- $alpha $nameTail* { TokenName }
<0> \n {begin bol}
<bol>
{
\n ;
() { doBOL }
}
{
data CoreToken = TokenLet
| TokenLetrec
| TokenIn
| TokenModule
| TokenWhere
| TokenComma
| TokenCase
| TokenOf
| TokenLambda
| TokenArrow
| TokenLitInt Int
| TokenName Name
| TokenSym Name
| TokenEquals
| TokenLParen
| TokenRParen
| TokenLBrace
| TokenRBrace
| TokenSemicolon
deriving Show
data LayoutContext = NoLayout
| Layout Int
data AlexUserState = AlexUserState
{ _ausContext :: [LayoutContext]
}
ausContext :: Lens' AlexUserState [LayoutContext]
ausContext = lens _ausContext (\s b -> s { _ausContext = b })
alexInitUserState = AlexUserState
{ _ausContext = []
}
-- lexCore :: String -> [CoreToken]
lexCore = alexScanTokens
-- lexSym :: String -> CoreToken
-- lexSym "=" = TokenEquals
-- lexSym "\\" = TokenLambda
-- lexSym "->" = TokenArrow
-- lexSym s = TokenSym s
lexSym = undefined
doBOL = undefined
alexEOF = undefined
alexScanTokens = undefined
}

View File

@@ -1,99 +0,0 @@
{-# LANGUAGE LambdaCase, BlockArguments #-}
module Core.Parse
( parseCore
, parseCoreExpr
)
where
----------------------------------------------------------------------------------
import Control.Parser
import Data.Functor ((<&>), ($>))
import Core.Lex
import Core.Syntax
----------------------------------------------------------------------------------
type CoreParser = ParserT [CoreToken] Result
parseCore :: [CoreToken] -> Result Program
parseCore = fmap snd . runParserT program
parseCoreExpr :: [CoreToken] -> Result Expr
parseCoreExpr = fmap snd . runParserT expr
program :: CoreParser Program
program = Program <$> termMany (char TokSemicolon) scdef
scdef :: CoreParser ScDef
scdef = ScDef <$> f <*> (xs <* eq) <*> body
where
f = name
xs = many name
eq = char TokEquals
body = expr
expr :: CoreParser Expr
expr = letE
<|> app
<|> lam
<|> atom
atom :: CoreParser Expr
atom = var
<|> con
<|> parenE
<|> lit
where
var = Var <$> name
parenE = surround (char TokLParen) (char TokRParen) expr
lit = IntE <$> litInt
lam :: CoreParser Expr
lam = Lam <$> (l *> bs) <*> (arrow *> expr)
where
l = char TokLambda
arrow = char TokArrow
bs = some name
app :: CoreParser Expr
app = foldl App <$> atom <*> some atom
con :: CoreParser Expr
con = pack *> (Con <$> (l *> tag) <*> (arity <* r))
where
l = char TokLBrace
r = char TokRBrace
tag = litInt
arity = litInt
pack = match \case
TokCName "Pack" -> Just ()
_ -> Nothing
letE :: CoreParser Expr
letE = Let <$> word <*> defs <*> (char TokIn *> expr)
where
word = char TokLet $> NonRec
<|> char TokLetRec $> Rec
defs = surround (char TokLBrace) (char TokRBrace) bindings
bindings :: CoreParser [Binding]
bindings = sepSome (char TokSemicolon) binding
binding :: CoreParser Binding
binding = Binding <$> name <*> (char TokEquals *> expr)
----------------------------------------------------------------------------------
name :: CoreParser Name
name = match \case
TokName n -> Just n
_ -> Nothing
cName :: CoreParser Name
cName = match \case
TokCName n -> Just n
_ -> Nothing
litInt :: CoreParser Int
litInt = match \case
TokLitInt n -> Just n
_ -> Nothing

82
src/Core/Parse.y Normal file
View File

@@ -0,0 +1,82 @@
{
module Core.Parse
( parseCore
-- , parseCoreExpr
, module Core.Lex -- temp convenience
)
where
import Data.Foldable (foldl')
import Core.Syntax
import Core.Lex
}
%name parseCore
%name parseCoreExpr Expr
%tokentype { CoreToken }
%error { parseError }
%token
let { TokenLet }
letrec { TokenLetrec }
module { TokenModule }
where { TokenWhere }
',' { TokenComma }
in { TokenIn }
litint { TokenLitInt $$ }
name { TokenName $$ }
sym { TokenSym $$ }
'λ' { TokenLambda }
'->' { TokenArrow }
'=' { TokenEquals }
'(' { TokenLParen }
')' { TokenRParen }
'{' { TokenLBrace }
'}' { TokenRBrace }
';' { TokenSemicolon }
%%
ExportList :: { [Name] }
ExportList : '(' Exports ')' { $2 }
Exports :: { [Name] }
Exports : Var ',' Exports { $1 : $3 }
| Var { [$1] }
Expr :: { Expr }
Expr : let Bindings in Expr { Let NonRec $2 $4 }
| letrec Bindings in Expr { Let Rec $2 $4 }
| 'λ' Binders '->' Expr { Lam $2 $4 }
| Application { $1 }
| Expr1 { $1 }
Binders :: { [Name] }
Binders : Var Binders { $1 : $2 }
| Var { [$1] }
Application :: { Expr }
Application : Expr1 AppArgs { foldl' App $1 $2 }
-- TODO: Application can probably be written as a single rule, without AppArgs
AppArgs :: { [Expr] }
AppArgs : Expr1 AppArgs { $1 : $2 }
| Expr1 { [$1] }
Expr1 :: { Expr }
Expr1 : litint { IntE $1 }
| Var { Var $1 }
| '(' Expr ')' { $2 }
Var :: { Name }
Var : '(' sym ')' { $2 }
| name { $1 }
Bindings :: { [Binding] }
Bindings : Var '=' Expr { [$1 := $3] }
{
parseError :: [CoreToken] -> a
parseError _ = error "fuuckk!"
}

View File

@@ -8,11 +8,13 @@ module Core.Syntax
, Alter(..) , Alter(..)
, Name , Name
, ScDef(..) , ScDef(..)
, Module(..)
, Program(..) , Program(..)
, corePrelude , corePrelude
, bindersOf , bindersOf
, rhssOf , rhssOf
, isAtomic , isAtomic
, insertModule
) )
where where
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
@@ -56,6 +58,9 @@ type Name = String
data ScDef = ScDef Name [Name] Expr data ScDef = ScDef Name [Name] Expr
deriving (Show, Lift) deriving (Show, Lift)
data Module = Module (Maybe (Name, [Name])) Program
deriving (Show, Lift)
newtype Program = Program [ScDef] newtype Program = Program [ScDef]
deriving (Show, Lift) deriving (Show, Lift)
@@ -64,6 +69,15 @@ instance IsString Expr where
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
instance Pretty Program where
-- TODO: module header
prettyPrec (Program ss) _ = mconcat $ intersperse "\n\n" $ fmap pretty ss
instance Pretty ScDef where
prettyPrec (ScDef n as e) _ =
mconcat (intersperse " " $ fmap IStr (n:as))
<> " = " <> pretty e <> IBreak
instance Pretty Expr where instance Pretty Expr where
prettyPrec (Var k) = withPrec maxBound $ IStr k prettyPrec (Var k) = withPrec maxBound $ IStr k
prettyPrec (IntE n) = withPrec maxBound $ iShow n prettyPrec (IntE n) = withPrec maxBound $ iShow n
@@ -106,7 +120,7 @@ instance Pretty Binding where
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
instance Semigroup Program where instance Semigroup Program where
(<>) = coerce $ (++) @ScDef (<>) = coerce $ (<>) @[ScDef]
instance Monoid Program where instance Monoid Program where
mempty = Program [] mempty = Program []
@@ -125,15 +139,19 @@ isAtomic _ = False
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------
corePrelude :: Program corePrelude :: Module
corePrelude = Program corePrelude = Module (Just ("Prelude", [])) $ Program
[ ScDef "id" ["x"] (Var "x") [ ScDef "id" ["x"] (Var "x")
, ScDef "K" ["x", "y"] (Var "x") , ScDef "k" ["x", "y"] (Var "x")
, ScDef "K1" ["x", "y"] (Var "y") , ScDef "k1" ["x", "y"] (Var "y")
, ScDef "S" ["f", "g", "x"] (Var "f" :$ Var "x" :$ (Var "g" :$ Var "x")) , ScDef "succ" ["f", "g", "x"] (Var "f" :$ Var "x" :$ (Var "g" :$ Var "x"))
, ScDef "compose" ["f", "g", "x"] (Var "f" :$ (Var "g" :$ Var "x")) , ScDef "compose" ["f", "g", "x"] (Var "f" :$ (Var "g" :$ Var "x"))
, ScDef "twice" ["f", "x"] (Var "f" :$ (Var "f" :$ Var "x")) , ScDef "twice" ["f", "x"] (Var "f" :$ (Var "f" :$ Var "x"))
, ScDef "False" [] $ Con 0 0 , ScDef "False" [] $ Con 0 0
, ScDef "True" [] $ Con 1 0 , ScDef "True" [] $ Con 1 0
] ]
-- TODO: export list awareness
insertModule :: Module -> Program -> Program
insertModule (Module _ m) p = p <> m

View File

@@ -27,13 +27,16 @@ coreExpr = QuasiQuoter
, quoteDec = error "core quasiquotes may only be used in expressions" , quoteDec = error "core quasiquotes may only be used in expressions"
} }
qCore :: String -> Q Exp qCore = undefined
qCore s = case lexCore s >>= parseCore of qCoreExpr = undefined
Success a -> lift a
Error e _ _ -> error e
qCoreExpr :: String -> Q Exp -- qCore :: String -> Q Exp
qCoreExpr s = case lexCore s >>= parseCoreExpr of -- qCore s = case lexCore s >>= parseCore of
Success a -> lift a -- Success a -> lift a
Error e _ _ -> error e -- Error e _ _ -> error e
-- qCoreExpr :: String -> Q Exp
-- qCoreExpr s = case lexCore s >>= parseCoreExpr of
-- Success a -> lift a
-- Error e _ _ -> error e

View File

@@ -71,7 +71,7 @@ compile prog = Just $ TiState s d h g stats
s = [mainAddr] s = [mainAddr]
d = [] d = []
(h,g) = buildInitialHeap defs (h,g) = buildInitialHeap defs
defs = prog <> corePrelude defs = insertModule corePrelude prog
stats = Stats 0 0 0 stats = Stats 0 0 0
mainAddr = fromJust $ lookup "main" g mainAddr = fromJust $ lookup "main" g
@@ -422,91 +422,91 @@ hdbgProg p hio = do
TiState [resAddr] _ h _ sts = last p' TiState [resAddr] _ h _ sts = last p'
res = hLookupUnsafe resAddr h res = hLookupUnsafe resAddr h
letrecExample :: Program -- letrecExample :: Program
letrecExample = Program -- letrecExample = Program
[ ScDef "pair" ["x","y","f"] $ "f" :$ "x" :$ "y" -- [ ScDef "pair" ["x","y","f"] $ "f" :$ "x" :$ "y"
, ScDef "fst" ["p"] $ "p" :$ "K" -- , ScDef "fst" ["p"] $ "p" :$ "K"
, ScDef "snd" ["p"] $ "p" :$ "K1" -- , ScDef "snd" ["p"] $ "p" :$ "K1"
, ScDef "f" ["x","y"] $ -- , ScDef "f" ["x","y"] $
Let Rec -- Let Rec
[ "a" := "pair" :$ "x" :$ "b" -- [ "a" := "pair" :$ "x" :$ "b"
, "b" := "pair" :$ "y" :$ "a" -- , "b" := "pair" :$ "y" :$ "a"
] -- ]
("fst" :$ ("snd" :$ ("snd" :$ ("snd" :$ "a")))) -- ("fst" :$ ("snd" :$ ("snd" :$ ("snd" :$ "a"))))
, ScDef "main" [] $ "f" :$ IntE 3 :$ IntE 4 -- , ScDef "main" [] $ "f" :$ IntE 3 :$ IntE 4
] -- ]
idExample :: Program -- idExample :: Program
idExample = Program -- idExample = Program
[ ScDef "main" [] $ "id" :$ IntE 3 -- [ ScDef "main" [] $ "id" :$ IntE 3
] -- ]
indExample1 :: Program -- indExample1 :: Program
indExample1 = Program -- indExample1 = Program
[ ScDef "main" [] $ "twice" :$ "twice" :$ "id" :$ IntE 3 -- [ ScDef "main" [] $ "twice" :$ "twice" :$ "id" :$ IntE 3
] -- ]
indExample2 :: Program -- indExample2 :: Program
indExample2 = Program -- indExample2 = Program
[ ScDef "main" [] $ "twice" :$ "twice" :$ "twice" :$ "id" :$ IntE 3 -- [ ScDef "main" [] $ "twice" :$ "twice" :$ "twice" :$ "id" :$ IntE 3
] -- ]
indExample3 :: Program -- indExample3 :: Program
indExample3 = Program -- indExample3 = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
Let Rec -- Let Rec
[ "x" := IntE 2 -- [ "x" := IntE 2
, "y" := "f" :$ "x" :$ "x" -- , "y" := "f" :$ "x" :$ "x"
] -- ]
("g" :$ "y" :$ "y") -- ("g" :$ "y" :$ "y")
, ScDef "f" ["a","b"] $ "b" -- , ScDef "f" ["a","b"] $ "b"
, ScDef "g" ["a","b"] $ "a" -- , ScDef "g" ["a","b"] $ "a"
] -- ]
negExample1 :: Program -- negExample1 :: Program
negExample1 = Program -- negExample1 = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
"negate#" :$ ("id" :$ IntE 3) -- "negate#" :$ ("id" :$ IntE 3)
] -- ]
negExample2 :: Program -- negExample2 :: Program
negExample2 = Program -- negExample2 = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
"negate#" :$ IntE 3 -- "negate#" :$ IntE 3
] -- ]
negExample3 :: Program -- negExample3 :: Program
negExample3 = Program -- negExample3 = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
"twice" :$ "negate#" :$ IntE 3 -- "twice" :$ "negate#" :$ IntE 3
] -- ]
arithExample1 :: Program -- arithExample1 :: Program
arithExample1 = Program -- arithExample1 = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
"+#" :$ (IntE 3) :$ ("negate#" :$ (IntE 2)) -- "+#" :$ (IntE 3) :$ ("negate#" :$ (IntE 2))
] -- ]
arithExample2 :: Program -- arithExample2 :: Program
arithExample2 = Program -- arithExample2 = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
"negate#" :$ ("+#" :$ (IntE 2) :$ ("*#" :$ IntE 5 :$ IntE 3)) -- "negate#" :$ ("+#" :$ (IntE 2) :$ ("*#" :$ IntE 5 :$ IntE 3))
] -- ]
ifExample :: Program -- ifExample :: Program
ifExample = Program -- ifExample = Program
[ ScDef "main" [] $ -- [ ScDef "main" [] $
"if#" :$ "True" :$ IntE 2 :$ IntE 3 -- "if#" :$ "True" :$ IntE 2 :$ IntE 3
] -- ]
facExample :: Program -- facExample :: Program
facExample = Program -- facExample = Program
[ ScDef "fac" ["n"] $ -- [ ScDef "fac" ["n"] $
"if#" :$ ("==#" :$ "n" :$ IntE 0) -- "if#" :$ ("==#" :$ "n" :$ IntE 0)
:$ (IntE 1) -- :$ (IntE 1)
:$ ("*#" :$ "n" :$ ("fac" :$ ("-#" :$ "n" :$ IntE 1))) -- :$ ("*#" :$ "n" :$ ("fac" :$ ("-#" :$ "n" :$ IntE 1)))
, ScDef "main" [] $ "fac" :$ IntE 3 -- , ScDef "main" [] $ "fac" :$ IntE 3
] -- ]
---------------------------------------------------------------------------------- ----------------------------------------------------------------------------------