erase arts in lifted where functions

This commit is contained in:
2025-10-24 11:09:57 -07:00
parent 11ffd96a91
commit 8aee58c23b
4 changed files with 35 additions and 17 deletions

View File

@@ -21,8 +21,10 @@ newt3.js: newt2.js
time $(RUNJS) newt2.js src/Main.newt -o newt3.js time $(RUNJS) newt2.js src/Main.newt -o newt3.js
cmp newt2.js newt3.js cmp newt2.js newt3.js
min.js: newt3.js min.js: newt3.js scripts/pack
scripts/pack scripts/pack
gzip -kf min.js
ls -l min.js min.js.gz
test: newt.js test: newt.js
scripts/test scripts/test

View File

@@ -2,6 +2,12 @@
## TODO ## TODO
- [ ] Remove erased args from primitive functions - [ ] Remove erased args from primitive functions
- [ ] consider moving primitive functions to a support file
- Downside here is that we lose some dead code elimination, but it better supports bootstrapping when calling convention changes.
- [ ] allow declaration of primitive operators
- Removes assumptions of hack in Compile.newt, but might not support other backends
- Alternate solution would be to pull from Prelude and hard code for all backends
- POper added to physical syntax types, but not implemented
- [x] Remove erased fields from constructor data - [x] Remove erased fields from constructor data
- [ ] Teach magic nat / magic enum about erased args - [ ] Teach magic nat / magic enum about erased args
- [ ] Update LiftLambda.newt for arg removal changes - [ ] Update LiftLambda.newt for arg removal changes

7
scripts/pack Executable file
View File

@@ -0,0 +1,7 @@
#!/bin/sh
(
echo '(function(){'
cat newt3.js
echo '})()'
) > iife.js
esbuild --minify iife.js > min.js

View File

@@ -8,22 +8,23 @@ import Lib.Ref2
import Data.SortedMap import Data.SortedMap
import Data.IORef import Data.IORef
-- track depth and whether we need to replace Bnd with a top level call -- track quantity, depth, and whether we need to replace Bnd with a top level call.
-- We _could_ keep track of the support and elide that as well.
LiftEnv : U LiftEnv : U
LiftEnv = List (Maybe (QName × Nat)) LiftEnv = List (Quant × Maybe (QName × List Quant))
liftWhereTm : {{Ref2 Defs St}} QName LiftEnv Tm M Tm liftWhereTm : {{Ref2 Defs St}} QName LiftEnv Tm M Tm
liftWhereTm name env (Lam fc nm icit quant t) = liftWhereTm name env (Lam fc nm icit quant t) =
Lam fc nm icit quant <$> liftWhereTm name (Nothing :: env) t Lam fc nm icit quant <$> liftWhereTm name ((quant, Nothing) :: env) t
liftWhereTm name env (App fc t u) = liftWhereTm name env (App fc t u) =
App fc <$> liftWhereTm name env t <*> liftWhereTm name env u App fc <$> liftWhereTm name env t <*> liftWhereTm name env u
liftWhereTm name env (Pi fc nm icit quant t u) = do liftWhereTm name env (Pi fc nm icit quant t u) = do
t <- liftWhereTm name env t t <- liftWhereTm name env t
u <- liftWhereTm name (Nothing :: env) u u <- liftWhereTm name ((quant, Nothing) :: env) u
pure $ Pi fc nm icit quant t u pure $ Pi fc nm icit quant t u
liftWhereTm name env (Let fc nm v sc) = do liftWhereTm name env (Let fc nm v sc) = do
v <- liftWhereTm name env v v <- liftWhereTm name env v
sc <- liftWhereTm name (Nothing :: env) sc sc <- liftWhereTm name ((Many, Nothing) :: env) sc
pure $ Let fc nm v sc pure $ Let fc nm v sc
liftWhereTm name env tm@(Case fc t alts) = do liftWhereTm name env tm@(Case fc t alts) = do
t <- liftWhereTm name env t t <- liftWhereTm name env t
@@ -35,16 +36,20 @@ liftWhereTm name env tm@(Case fc t alts) = do
liftWhereAlt (CaseDefault tm) = CaseDefault <$> liftWhereTm name env tm liftWhereAlt (CaseDefault tm) = CaseDefault <$> liftWhereTm name env tm
liftWhereAlt (CaseLit l tm) = CaseLit l <$> liftWhereTm name env tm liftWhereAlt (CaseLit l tm) = CaseLit l <$> liftWhereTm name env tm
liftWhereAlt (CaseCons qn args tm) = liftWhereAlt (CaseCons qn args tm) =
CaseCons qn args <$> liftWhereTm name (map (const Nothing) args ++ env) tm -- TODO - can we pull quantities off of these arguments?
-- We should switch to SnocList first, the args are backwards here
CaseCons qn args <$> liftWhereTm name ((map (const (Many, Nothing)) args) ++ env) tm
-- This is where the magic happens -- This is where the magic happens
liftWhereTm name env (LetRec fc nm ty t u) = do liftWhereTm name env (LetRec fc nm ty t u) = do
let l = length env -- let l = length env
qn <- getName name nm qn <- getName name nm
let env' = (Just (qn, S l) :: env) -- I'll erase this one, since we're replacing all of the usages
let qs = Zero :: map fst env
let env' = ((Zero, Just (qn, qs)) :: env)
-- environment should subst this function (see next case) -- environment should subst this function (see next case)
t' <- liftWhereTm qn env' t t' <- liftWhereTm qn env' t
-- TODO we could have subst in this var and dropped the extra argument -- TODO we could have subst in this var and dropped the extra argument
modifyRef Defs (updateMap qn (Fn $ wrapLam (S l) t')) modifyRef Defs (updateMap qn (Fn $ wrapLam qs t'))
-- The rest -- The rest
u' <- liftWhereTm qn env' u u' <- liftWhereTm qn env' u
@@ -58,19 +63,18 @@ liftWhereTm name env (LetRec fc nm ty t u) = do
let (Just _) = lookupMap qn' top | _ => pure qn' let (Just _) = lookupMap qn' top | _ => pure qn'
getName qn (ext ++ "'") getName qn (ext ++ "'")
wrapLam : Nat Tm Tm wrapLam : List Quant Tm Tm
wrapLam Z tm = tm wrapLam Nil tm = tm
-- REVIEW We've already erased, hopefully we don't need quantity wrapLam (q :: qs) tm = wrapLam qs $ Lam fc "_" Explicit q tm
wrapLam (S k) tm = Lam fc "_" Explicit Many $ wrapLam k tm
-- And where it lands -- And where it lands
liftWhereTm name env tm@(Bnd fc k) = case getAt (cast k) env of liftWhereTm name env tm@(Bnd fc k) = case getAt (cast k) env of
Just (Just (qn, v)) => pure $ apply (length' env) (cast v) (Ref fc qn) Just (_, Just (qn, v)) => pure $ apply (length' env) (length' v) (Ref fc qn)
_ => pure tm _ => pure tm
where where
apply : Int Int Tm Tm apply : Int Int Tm Tm
apply l 0 tm = tm apply l 0 tm = tm
-- (l - k) is like lvl2ix, but witih k one bigger -- (l - k) is like lvl2ix, but with k one bigger
apply l k tm = App fc (apply l (k - 1) tm) (Bnd fc (l - k)) apply l k tm = App fc (apply l (k - 1) tm) (Bnd fc (l - k))
liftWhereTm name env tm = pure tm liftWhereTm name env tm = pure tm
@@ -78,7 +82,6 @@ liftWhereFn : {{Ref2 Defs St}} → QName × Def → M Unit
liftWhereFn (name, Fn tm) = do liftWhereFn (name, Fn tm) = do
tm' <- liftWhereTm name Nil tm tm' <- liftWhereTm name Nil tm
modifyRef Defs $ updateMap name (Fn tm') modifyRef Defs $ updateMap name (Fn tm')
-- updateDef name fc type (Fn tm')
liftWhereFn _ = pure MkUnit liftWhereFn _ = pure MkUnit
liftWhere : {{Ref2 Defs St}} M Unit liftWhere : {{Ref2 Defs St}} M Unit