@@ -7,7 +7,7 @@ import Data.Array as Array
77import Data.Array.NonEmpty as NEA
88import Data.Array.NonEmpty as NonEmptyArray
99import Data.Maybe (Maybe(..))
10−import Data.Newtype (un, unwrap, wrap)
10+import Data.Newtype (unwrap, wrap)
1111import Data.Set as Set
1212import Data.String.CodeUnits as CodeUnits
1313import Data.Tuple (Tuple(..), uncurry)
@@ -74,72 +74,17 @@ codegenTopLevelBindingGroup codegenEnv { recursive, bindings }
7474 | recursive, Just bindings' <- NonEmptyArray.fromArray bindings =
7575 [ DefineValue "rtlbg" $ S.Identifier "recursive-top-level-binding-group" ]
7676 | otherwise =
77− map (codegenTopLevelBinding codegenEnv) bindings
77+ codegenTopLevelBinding codegenEnv <$> bindings
7878
7979codegenTopLevelBinding :: CodegenEnv -> Tuple Ident NeutralExpr -> ChezDefinition
80−codegenTopLevelBinding codegenEnv@{ currentModule } (Tuple (Ident ident) expr) = case unwrap expr of
81− Var (Qualified (Just moduleName) (Ident v))
82− | currentModule == moduleName -> DefineValue ident $ S.Identifier v
83− | otherwise -> DefineValue ident $ S.Identifier $ coerce moduleName <> "." <> v
84− Var (Qualified Nothing (Ident v)) ->
85− DefineValue ident $ S.Identifier v
86− Local i l ->
87− DefineValue ident $ S.Identifier $ coerce $ S.toChezIdent i l
88− Lit l ->
89− DefineValue ident $ codegenLiteral codegenEnv l
90− App f p ->
91− DefineValue ident $ S.chezCurriedApplication (codegenExpr codegenEnv f)
92− (codegenExpr codegenEnv <$> p)
93− Abs a e -> do
94− DefineCurriedFunction
95− ident
96− (map (un Ident <<< uncurry S.toChezIdent) $ a)
97− (codegenExpr codegenEnv e)
98−
99− UncurriedApp _ _ ->
100− DefineValue ident $ S.Identifier "uncurried-app"
101− UncurriedAbs _ _ ->
102− DefineValue ident $ S.Identifier "uncurried-abs"
103−
104− UncurriedEffectApp _ _ ->
105− DefineValue ident $ S.Identifier "uncurried-effect-app"
106− UncurriedEffectAbs _ _ ->
107− DefineValue ident $ S.Identifier "uncurried-effect-ab"
108−
109− Accessor _ _ ->
110− DefineValue ident $ S.Identifier "object-accessor"
111− Update _ _ ->
112− DefineValue ident $ S.Identifier "object-update"
113−
114− CtorSaturated _ _ _ _ _ ->
115− DefineValue ident $ S.Identifier "ctor-saturated"
116− CtorDef _ _ _ _ ->
117− DefineValue ident $ S.Identifier "ctor-def"
118−
119− LetRec _ _ _ ->
120− DefineValue ident $ S.Identifier "let-rec"
121− Let i l v e ->
122− DefineValue ident $ S.chezLet (S.toChezIdent i l) (codegenExpr codegenEnv v)
123− (codegenExpr codegenEnv e)
124− Branch _ _ ->
125− DefineValue ident $ S.Identifier "branch"
126−
127− EffectBind _ _ _ _ ->
128− DefineValue ident $ S.Identifier "effect-bind"
129− EffectPure _ ->
130− DefineValue ident $ S.Identifier "effect-pure"
131− EffectDefer _ ->
132− DefineValue ident $ S.Identifier "effect-defer"
133−
134− PrimOp _ ->
135− DefineValue ident $ S.Identifier "prim-op"
136− PrimEffect _ ->
137− DefineValue ident $ S.Identifier "prim-effect"
138− PrimUndefined ->
139− DefineValue ident $ S.Identifier "prim-undefined"
140−
141− Fail _ ->
142− DefineValue ident $ S.Identifier "fail"
80+codegenTopLevelBinding codegenEnv (Tuple (Ident i) n) =
81+ case unwrap n of
82+ Abs a e ->
83+ DefineCurriedFunction i (uncurry S.toChezIdent <$> a) (codegenExpr codegenEnv e)
84+ UncurriedAbs a e ->
85+ DefineUncurriedFunction i (uncurry S.toChezIdent <$> a) (codegenExpr codegenEnv e)
86+ _ ->
87+ DefineValue i $ codegenExpr codegenEnv n
14388
14489codegenExpr :: CodegenEnv -> NeutralExpr -> ChezExpr
14590codegenExpr codegenEnv@{ currentModule } (NeutralExpr s) = case s of