diff --git a/.gitignore b/.gitignore index 29b9fc1d47..b2f70d4efa 100644 --- a/.gitignore +++ b/.gitignore @@ -31,3 +31,4 @@ node_modules/ .stack-work/ build/ .tmp/ +_region_.tex \ No newline at end of file diff --git a/src/NewStyle.hs b/src/NewStyle.hs index 8f58f0745f..0c0dd41dc2 100644 --- a/src/NewStyle.hs +++ b/src/NewStyle.hs @@ -842,9 +842,11 @@ newtype SProperty = Prop' String -- TODO: add lists to S.TypeIn -- TODO: S.TypeIn doesn't support objfns etc -data GPICtor = Ellip | Circle | Box | Rectangle | Dot | Arrow | NoShape | Color | Text | Curve | Auto - | Arc2 | Line2 | Parallel | Image | AnchorPoint | CurlyBrace - deriving (Show, Eq, Ord, Typeable) -- Ord for M.toList in Runtime +type GPICtor = String -- TODO: clean up this typeseq + +-- data GPICtor = Ellip | Circle | Box | Rectangle | Dot | Arrow | NoShape | Color | Text | Curve | Auto + -- | Arc2 | Line2 | Parallel | Image | AnchorPoint | CurlyBrace + -- deriving (Show, Eq, Ord, Typeable) -- Ord for M.toList in Runtime data TagExpr a = OptEval Expr -- Thunk evaluated at each step of optimization-time | Done (S.TypeIn a) -- A value in the host language, fully evaluated @@ -889,25 +891,24 @@ nameStr :: Name -> String nameStr (Sub s) = s nameStr (Gen s) = s --- TODO: replace this with styObj parser -toCtorType :: String -> GPICtor -toCtorType "Color" = Color -toCtorType "None" = NoShape -toCtorType "Arrow" = Arrow -toCtorType "Text" = Text -toCtorType "Circ" = Circle -- TODO: Circle parsing??? -toCtorType "Curve" = Curve -toCtorType "Ellipse" = Ellip -toCtorType "Box" = Box -toCtorType "Arc" = Arc2 -toCtorType "Rectangle" = Rectangle -toCtorType "Parallelogram" = Parallel -toCtorType "Dot" = Dot -toCtorType "Line" = Line2 -toCtorType "Image" = Image -toCtorType "AnchorPoint" = AnchorPoint -toCtorType "CurlyBrace" = CurlyBrace -toCtorType s = error ("Unrecognized shape: " ++ s) +-- toCtorType :: String -> GPICtor +-- toCtorType "Color" = Color +-- toCtorType "None" = NoShape +-- toCtorType "Arrow" = Arrow +-- toCtorType "Text" = Text +-- toCtorType "Circ" = Circle -- TODO: Circle parsing??? +-- toCtorType "Curve" = Curve +-- toCtorType "Ellipse" = Ellip +-- toCtorType "Box" = Box +-- toCtorType "Arc" = Arc2 +-- toCtorType "Rectangle" = Rectangle +-- toCtorType "Parallelogram" = Parallel +-- toCtorType "Dot" = Dot +-- toCtorType "Line" = Line2 +-- toCtorType "Image" = Image +-- toCtorType "AnchorPoint" = AnchorPoint +-- toCtorType "CurlyBrace" = CurlyBrace +-- toCtorType s = error ("Unrecognized shape: " ++ s) mkPropertyDict :: (Autofloat a) => [PropertyDecl] -> PropertyDict a mkPropertyDict propertyDecls = foldl addPropertyDecl M.empty propertyDecls @@ -1007,7 +1008,7 @@ addField override trans name field texpr = -- TODO: check existing FExpr is overridden by an FExpr and likewise for Ctor of same type (typechecking) let fieldExpr = case texpr of OptEval (Ctor ctorName propertyDecls) -> -- rule Line-Set-Ctor - GPI (toCtorType ctorName) (mkPropertyDict propertyDecls) + GPI ctorName (mkPropertyDict propertyDecls) _ -> FExpr texpr in -- rule Line-Set-Field-Expr let fieldDict' = M.insert field fieldExpr fieldDict trn' = M.insert name fieldDict' trn in @@ -1139,8 +1140,8 @@ data RState a = RState { objs :: [S.Obj] } -- TODO -- TODO: Style cannot parse property names like "stroke-width" floatProperties = M.fromList [ - (Circle, ["r", "x", "y", "strokeWidth"]), - (Rectangle, ["x", "y", "length", "width", "angle"]) ] + ("Circ", ["r", "x", "y", "strokeWidth"]), + ("Rectangle", ["x", "y", "length", "width", "angle"]) ] -- ["x", "y", "r", "radius", "rx", "ry", "angle", "side", -- "stroke-width", "rotation", "length", "width", "startx", -- "starty", "endx", "endy", "thickness"] @@ -1195,10 +1196,10 @@ findVarying = foldSubObjs findFieldVarying -- findFieldFns name field (FExpr (OptEval expr)) acc = - let res = case expr of - ObjFn fname args -> Left (fname, args) - ConstrFn fname args -> Right (fname, args) - in res : acc + case expr of + ObjFn fname args -> Left (fname, args) : acc + ConstrFn fname args -> Right (fname, args) : acc + _ -> acc -- Not an optfn findFieldFns name field (GPI _ _) acc = acc findObjfnsConstrs = foldSubObjs findFieldFns @@ -1232,8 +1233,7 @@ toTagExpr n = Done (S.TNum n) --- Evaluation -- Fully evaluated inputs --- TODO: fix GPIArg input (just propertydict; should we store GPI name?) -data ArgVal a = GPIArg (M.Map Field (PropertyDict a)) | ValueArg (S.TypeIn a) +data ArgVal a = GPIArg GPICtor (PropertyDict a) | ValueArg (S.TypeIn a) deriving (Eq, Show) type OptFn a = [ArgVal a] -> a @@ -1244,16 +1244,32 @@ testCompFn [ValueArg (S.TStr str), ValueArg (S.TInt n)] = let res = concat $ take (fromIntegral n) $ repeat str in ValueArg (S.TStr res) +noop :: (Autofloat a) => CompFn' a +noop _ = ValueArg $ S.TStr "TODO: this is a no-op" + compDict :: (Autofloat a) => M.Map String (CompFn' a) compDict = M.fromList flist - where flist = [("testCompFn", testCompFn)] -- TODO: port existing comps + where flist = [("testCompFn", testCompFn), + ("bbox", noop), + ("curved", noop), + ("len", noop), + ("sampleMatrix", noop), + ("sampleVectorIn", noop), + ("intersection", noop), + ("midpoint", noop), + ("mulV", noop), + ("determinant", noop), + ("rgba", noop), + ("addV", noop), + ("apply", noop) + ] -- TODO: port existing comps -- TODO: write a more general typechecking mechanism evalUop :: (Autofloat a) => UnaryOp -> ArgVal a -> S.TypeIn a evalUop UMinus v = case v of ValueArg (S.TNum a) -> S.TNum (-a) ValueArg (S.TInt i) -> S.TInt (-i) - GPIArg _ -> error "cannot negate a GPI" + GPIArg _ _ -> error "cannot negate a GPI" ValueArg _ -> error "wrong type to negate" evalUop UPlus v = error "unary + doesn't make sense" -- TODO remove from parser @@ -1275,23 +1291,39 @@ evalBinop op v1 v2 = Divide -> if n2 == 0 then error "divide by 0!" else S.TInt $ n1 `quot` n2 -- NOTE: not float Exp -> S.TInt $ n1 ^ n2 -- Cannot mix int and float - (ValueArg _, ValueArg _) -> error "wrong field types for binary operation" - (GPIArg _, ValueArg _) -> error "binop cannot operate on GPI" - (ValueArg _, GPIArg _) -> error "binop cannot operate on GPI" - (GPIArg _, GPIArg _) -> error "binop cannot operate on GPIs" - --- TODO: what about args like "5 + 10" or "5 + A.val"? those don't have paths --- recursively evaluate, TODO track iteration depth + (ValueArg _, ValueArg _) -> error ("wrong field types for binary op: " ++ show v1 ++ show op ++ show v2) + (GPIArg _ _, ValueArg _) -> error "binop cannot operate on GPI" + (ValueArg _, GPIArg _ _) -> error "binop cannot operate on GPI" + (GPIArg _ _, GPIArg _ _) -> error "binop cannot operate on GPIs" + +evalProperty :: (Autofloat a) => BindingForm -> Field -> Translation a -> (Property, TagExpr a) -> Translation a +evalProperty bvar field trans (property, expr) = + let path = EPath $ PropertyPath bvar field property in -- factor out? + let (_, trans') = evalExpr path trans in -- Doesn't need evaluated value + trans' + +evalGPI_withUpdate :: (Autofloat a) => BindingForm -> Field -> (GPICtor, PropertyDict a) + -> Translation a -> ((GPICtor, PropertyDict a), Translation a) +evalGPI_withUpdate bvar field (ctor, properties) trans = + -- Fold over the properties, evaluating each path, which will update the translation each time + let trans' = foldl (evalProperty bvar field) trans (M.toList properties) in + -- Look up the final evaluated GPI + let properties' = case lookupField bvar field trans' of + GPI ctorT propertiesT -> if ctor == ctorT then propertiesT else error "wrong ctor" + FExpr _ -> error "expected GPI but got field" in + ((ctor, properties'), trans') + +-- recursively evaluate, TODO track iteration depth and check for cycles in graph evalExpr :: (Autofloat a) => Expr -> Translation a -> (ArgVal a, Translation a) evalExpr arg trans = case arg of - -- Already done values; don't change grans + -- Already done values; don't change trans IntLit i -> (ValueArg $ S.TInt i, trans) StringLit s -> (ValueArg $ S.TStr s, trans) AFloat (Fix f) -> (ValueArg $ S.TNum (r2f f), trans) -- TODO: note use of r2f here. is that ok? -- Inline computation, needs a recursive lookup that may change trans, but not a path - -- TODO factor out eval / trans computation + -- TODO factor out eval / trans computation? UOp op e -> let (val, trans') = evalExpr e trans in let compVal = evalUop op val in @@ -1324,15 +1356,16 @@ evalExpr arg trans = let (v, trans') = evalExpr e trans in case v of ValueArg fval -> - case insertPath trans (p, Done fval) of + case insertPath trans' (p, Done fval) of Right trans' -> (v, trans') Left err -> error $ concat err - GPIArg _ -> error "path to field expr evaluated to a GPI" - GPI ctor properties -> error "TODO" - -- >>> fill in - -- Eval the GPI (as expr `Ctor ctor properties`), then insert the evaluated GPI - -- into the translation and return it - -- TODO: need "insert GPI" + GPIArg _ _ -> error "path to field expr evaluated to a GPI" + GPI ctor properties -> + -- Eval each property in the GPI, then lookup the updated GPI in the translation and return it + -- No need to update the translation because each path should update the translation + let (gpiVal@(ctor, propertiesVal), trans') = + evalGPI_withUpdate bvar field (ctor, properties) trans in + (GPIArg ctor propertiesVal, trans') PropertyPath bvar field property -> let texpr = lookupProperty bvar field property trans in @@ -1342,15 +1375,13 @@ evalExpr arg trans = let (v, trans') = evalExpr e trans in case v of ValueArg fval -> - case insertPath trans (p, Done fval) of + case insertPath trans' (p, Done fval) of Right trans' -> (v, trans') Left err -> error $ concat err - GPIArg _ -> error "path to property expr evaluated to a GPI" + GPIArg _ _ -> error ("path to property expr '" ++ pathStr p ++ "' evaluated to a GPI") -- GPI argument - Ctor ctor properties -> - (GPIArg $ M.empty, trans) -- >>> fill in - -- need to evaluate each property in a GPI + Ctor ctor properties -> error "no anonymous/inline GPIs allowed as expressions!" -- Error Layering _ -> error "layering should not be an objfn arg (or in the children of one)" diff --git a/src/paper-eval/linear-algebra.sty b/src/paper-eval/linear-algebra.sty index 0b13399794..bd37efdd79 100644 --- a/src/paper-eval/linear-algebra.sty +++ b/src/paper-eval/linear-algebra.sty @@ -6,8 +6,8 @@ global { } CANVAS { - CANVAS.width = 200 - CANVAS.height = 400 + CANVAS.width = 200.0 + CANVAS.height = 400.0 } Colors { @@ -43,21 +43,27 @@ VectorSpace U { } U.angle = Arc { - from = U.x_axis - to = U.y_axis + -- from = U.x_axis + -- to = U.y_axis } + U.text = Text { } + U.labelFn = encourage topLeft(U.text, U.shape) } LinearMap f; VectorSpace U, V where From(f, U, V) { f.val = sampleMatrix(2, 2) -- could be optimized + f.shape = Arrow { - from = U.shape - to = V.shape + -- from = U.shape + -- to = V.shape style = LineStyles.curved } + + f.text = Text { } + f.posFn = encourage between(f.shape, U.shape, V.shape) f.labelFn = encourage nearCenter(f.text, f.shape) } @@ -66,11 +72,15 @@ Vector v with VectorSpace V where In(v, V) { v.val = sampleVectorIn(V.shape) + v.shape = Arrow { tail = V.origin head = v.val color = Colors.blue } + + v.text = Text { } + v.labelFn = encourage near(v.text, v.shape.head) } @@ -113,10 +123,12 @@ where c := norm(v); In(v, V) { override c.val = len(v.shape) c.shape = CurlyBrace { - along = v.shape + -- along = v.shape color = Colors.gray } + c.text = Text { } + c.labelFn = encourage aligned(c.text, c.shape) } @@ -127,14 +139,19 @@ where c := determinant(v, w); In(v, V); In(w, V) { override c.val = determinant(v.val, w.val) c.shape = Parallelogram { - side1 = v.shape - side2 = w.shape + -- side1 = v.shape + -- side2 = w.shape opacity = 0.5 } + c.text = Text { } + c.labelFn = encourage centered(c.text, c.shape) c.layering = [V < c < (v == w)] } - -- TODO: write inner product semantics \ No newline at end of file + -- TODO: write inner product semantics + -- TODO: put labels back in + -- TODO: deal with ``from'', ``to'', ``side1'', ``side2'', ``along'' being paths to GPIs (should this be allowed??) + -- TODO: get working namespaces \ No newline at end of file diff --git a/src/sty/test-sty-init.sty b/src/sty/test-sty-init.sty index 15551db496..3761454a71 100644 --- a/src/sty/test-sty-init.sty +++ b/src/sty/test-sty-init.sty @@ -2,17 +2,20 @@ global { } Scalar c { c.shape = Circ { - r = 10 + strokeWidth = -1.5 + c.shape.r + r = 10.0 + 10.0 } - c.labelFn = encourage near(c.shape, c.shape) + c.labelFn = encourage near(c.shape.r) } Scalar `m` { `m`.shape.x = 2.5 + 0.2 `m`.shape.y = `m`.shape.r + `m`.shape.strokeWidth + `m`.shape.x - - -- TODO: add more nested computation, test cyclic computation - + `m`.inFn = ensure lessThan(`m`.shape.y, 10 + 3) -} \ No newline at end of file +} + + -- TODO: document how order of statements affects eval + -- TODO: add more nested computation, test cyclic computation +