erase arts in lifted where functions
This commit is contained in:
4
Makefile
4
Makefile
@@ -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
|
||||||
|
|||||||
6
TODO.md
6
TODO.md
@@ -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
7
scripts/pack
Executable file
@@ -0,0 +1,7 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
(
|
||||||
|
echo '(function(){'
|
||||||
|
cat newt3.js
|
||||||
|
echo '})()'
|
||||||
|
) > iife.js
|
||||||
|
esbuild --minify iife.js > min.js
|
||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user